- module energy
+ module energy
!-----------------------------------------------------------------------------
use io_units
use names
gvdwc_peppho
!------------------------------IONS GRADIENT
real(kind=8),dimension(:,:),allocatable :: gradcatcat, &
- gradpepcat,gradpepcatx
+ gradpepcat,gradpepcatx,gradnuclcat,gradnuclcatx,gradcattranx,&
+ gradcattranc,gradcatangc,gradcatangx
! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
-
+!----------------------------------------
+ real(kind=8),dimension(:,:),allocatable ::gradlipelec,gradlipbond,&
+ gradlipang,gradliplj,gradpepmart, gradpepmartx
real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
!-----------------------------------------------------------------------------
! common.sbridge
! common /dyn_ssbond/
- real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
+ real(kind=8),dimension(:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
!-----------------------------------------------------------------------------
! common.sccor
! Parameters of the SCCOR term
! common /przechowalnia/
real(kind=8),dimension(:,:,:),allocatable :: zapas
real(kind=8),dimension(:,:,:,:),allocatable ::zapas2 !(max_dim,maxconts,max_fg_procs)
+#ifdef FIVEDIAG
+ real(kind=8),dimension(:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
+#else
real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
+#endif
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!
! energy_p_new_barrier.F
!-----------------------------------------------------------------------------
subroutine etotal(energia)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
use MD_data
#ifndef ISNAN
! include 'COMMON.TIME1'
real(kind=8) :: time00
!el local variables
- integer :: n_corr,n_corr1,ierror
+ integer :: n_corr,n_corr1,ierror,imatupdate
real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
Eafmforce,ethetacnstr
- real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
+ real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6,ehomology_constr
! now energies for nulceic alone parameters
real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
ecorr3_nucl
! energies for ions
- real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber
+ real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
+ ecation_nucl,ecat_prottran,ecation_protang
! energies for protein nucleic acid interaction
real(kind=8) :: escbase,epepbase,escpho,epeppho
+! energies for MARTINI
+ real(kind=8) :: elipbond,elipang,elipelec,eliplj,elipidprot
#ifdef MPI
real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
! shielding effect varibles for MPI
- real(kind=8) :: fac_shieldbuf(nres), &
- grad_shield_locbuf1(3*maxcontsshi*nres), &
- grad_shield_sidebuf1(3*maxcontsshi*nres), &
- grad_shield_locbuf2(3*maxcontsshi*nres), &
- grad_shield_sidebuf2(3*maxcontsshi*nres), &
- grad_shieldbuf1(3*nres), &
- grad_shieldbuf2(3*nres)
-
- integer ishield_listbuf(-1:nres), &
- shield_listbuf(maxcontsshi,-1:nres),k,j,i,iii,impishi,mojint,jjj
-
-
+ real(kind=8) :: fac_shieldbuf(nres_molec(1)), &
+ grad_shield_locbuf1(3*maxcontsshi*nres_molec(1)), &
+ grad_shield_sidebuf1(3*maxcontsshi*nres_molec(1)), &
+ grad_shield_locbuf2(3*maxcontsshi*nres_molec(1)), &
+ grad_shield_sidebuf2(3*maxcontsshi*nres_molec(1)), &
+ grad_shieldbuf1(3*nres_molec(1)), &
+ grad_shieldbuf2(3*nres_molec(1))
+
+ integer ishield_listbuf(-1:nres_molec(1)), &
+ shield_listbuf(maxcontsshi,-1:nres_molec(1)),k,j,i,iii,impishi,mojint,jjj
+ integer :: imatupdate2
+! print *,"I START ENERGY"
+ imatupdate=100
+ imatupdate2=100
+! if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list
! real(kind=8), dimension(:),allocatable:: fac_shieldbuf
! real(kind=8), dimension(:,:,:),allocatable:: &
! grad_shield_locbuf,grad_shield_sidebuf
! allocate(ishield_listbuf(nres))
! allocate(shield_listbuf(maxcontsshi,nres))
! endif
-
+! print *,"wstrain check", wstrain
! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
! & " nfgtasks",nfgtasks
if (nfgtasks.gt.1) then
weights_(47)=wpepbase
weights_(48)=wscpho
weights_(49)=wpeppho
+ weights_(50)=wcatnucl
+ weights_(56)=wcat_tran
+ weights_(58)=wlip_prot
+ weights_(52)=wmartini
! wcatcat= weights(41)
! wcatprot=weights(42)
wpepbase=weights(47)
wscpho=weights(48)
wpeppho=weights(49)
+ wcatnucl=weights(50)
+ wmartini=weights(52)
+ wcat_tran=weights(56)
+ wlip_prot=weights(58)
! welpsb=weights(28)*fact(1)
!
! wcorr_nucl= weights(37)*fact(1)
time_Bcastw=time_Bcastw+MPI_Wtime()-time00
! call chainbuild_cart
endif
+! print *,"itime_mat",itime_mat,imatupdate
+ if (nfgtasks.gt.1) then
+ call MPI_Bcast(itime_mat,1,MPI_INT,king,FG_COMM,IERROR)
+ endif
+ if (nres_molec(1).gt.0) then
+ if (mod(itime_mat,imatupdate).eq.0) call make_SCp_inter_list
+! write (iout,*) "after make_SCp_inter_list"
+ if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list
+! write (iout,*) "after make_SCSC_inter_list"
+ if (nres_molec(4).gt.0) then
+ if (mod(itime_mat,imatupdate).eq.0) call make_lip_pep_list
+ endif
+ if (mod(itime_mat,imatupdate).eq.0) call make_pp_inter_list
+ if (nres_molec(5).gt.0) then
+ if (mod(itime_mat,imatupdate).eq.0) then
+! print *,'Processor',myrank,' calling etotal ipot=',ipot
+ call make_cat_pep_list
+! call make_cat_cat_list
+ endif
+ endif
+ endif
+ if (nres_molec(5).gt.0) then
+ if (mod(itime_mat,imatupdate2).eq.0) then
+! print *, "before cat cat"
+! print *,'Processor',myrank,' calling etotal ipot=',ipot
+! call make_cat_pep_list
+ call make_cat_cat_list
+ endif
+ endif
+! write (iout,*) "after make_pp_inter_list"
+
! print *,'Processor',myrank,' calling etotal ipot=',ipot
! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
#else
! Compute the side-chain and electrostatic interaction energy
! print *, "Before EVDW"
! goto (101,102,103,104,105,106) ipot
+ if (nres_molec(1).gt.0) then
select case(ipot)
! Lennard-Jones potential.
! 101 call elj(evdw)
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
call epsb(evdwpsb,eelpsb)
call esb(esbloc)
call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
+ call ecat_nucl(ecation_nucl)
else
etors_nucl=0.0d0
estr_nucl=0.0d0
ecorr3_nucl=0.0d0
+ ecorr_nucl=0.0d0
ebe_nucl=0.0d0
evdwsb=0.0d0
eelsb=0.0d0
eelpsb=0.0d0
evdwpp=0.0d0
eespp=0.0d0
+ etors_d_nucl=0.0d0
+ ecation_nucl=0.0d0
endif
! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
! print *,"before ecatcat",wcatcat
- if (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)
+ if (nres_molec(5).gt.0) then
+ if (g_ilist_catsctran.gt.0) then
+ call ecat_prot_transition(ecat_prottran)
+ else
+ ecat_prottran=0.0d0
+ endif
+ if (g_ilist_catscang.gt.0) then
+ call ecat_prot_ang(ecation_protang)
+ else
+ ecation_protang=0.0d0
+ endif
+! if (nfgtasks.gt.1) then
+! if (fg_rank.eq.0) then
+ if (nres_molec(5).gt.1) call ecatcat(ecationcation)
+! endif
+! else
+! if (nres_molec(5).gt.1) call ecatcat(ecationcation)
+! endif
+ if (oldion.gt.0) then
+ if (g_ilist_catpnorm.gt.0) call ecat_prot(ecation_prot)
+ else
+ if (g_ilist_catpnorm.gt.0) call ecats_prot_amber(ecation_prot)
+ endif
else
- call ecats_prot_amber(ecation_prot)
+ ecationcation=0.0d0
+ ecation_prot=0.0d0
+ ecation_protang=0.0d0
+ ecat_prottran=0.0d0
endif
- if (nres_molec(2).gt.0) then
+ if (g_ilist_catscnorm.eq.0) ecation_prot=0.0d0
+ if ((nres_molec(2).gt.0).and.(nres_molec(1).gt.0)) then
call eprot_sc_base(escbase)
call epep_sc_base(epepbase)
call eprot_sc_phosphate(escpho)
escpho=0.0
epeppho=0.0
endif
+! MARTINI FORCE FIELD ENERGY TERMS
+ if (nres_molec(4).gt.0) then
+ if (nfgtasks.gt.1) then
+ if (fg_rank.eq.0) then
+ call lipid_bond(elipbond)
+ call lipid_angle(elipang)
+ endif
+ else
+ call lipid_bond(elipbond)
+ call lipid_angle(elipang)
+ endif
+ call lipid_LJ(eliplj)
+ call lipid_elec(elipelec)
+ if (nres_molec(1).gt.0) then
+ call elip_prot(elipidprot)
+ else
+ elipidprot=0.0d0
+ endif
+ else
+ elipbond=0.0d0
+ elipang=0.0d0
+ eliplj=0.0d0
+ elipelec=0.0d0
+ endif
! call ecatcat(ecationcation)
! print *,"after ebend", wtor_nucl
#ifdef TIMING
energia(48)=escpho
energia(49)=epeppho
! energia(50)=ecations_prot_amber
+ energia(50)=ecation_nucl
+ energia(51)=ehomology_constr
+! energia(51)=homology
+ energia(52)=elipbond
+ energia(53)=elipang
+ energia(54)=eliplj
+ energia(55)=elipelec
+ energia(56)=ecat_prottran
+ energia(57)=ecation_protang
+ energia(58)=elipidprot
+! write(iout,*) elipelec,"elipelec"
+! write(iout,*) elipang,"elipang"
+! write(iout,*) eliplj,"eliplj"
call sum_energy(energia,.true.)
if (dyn_ss) call dyn_set_nss
! print *," Processor",myrank," left SUM_ENERGY"
end subroutine etotal
!-----------------------------------------------------------------------------
subroutine sum_energy(energia,reduce)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifndef ISNAN
external proc_proc
eliptran,etube, Eafmforce,ethetacnstr
real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
- ecorr3_nucl
- real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber
+ ecorr3_nucl,ehomology_constr
+ real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
+ ecation_nucl,ecat_prottran,ecation_protang
real(kind=8) :: escbase,epepbase,escpho,epeppho
integer :: i
+ real(kind=8) :: elipbond,elipang,eliplj,elipelec,elipidprot
#ifdef MPI
integer :: ierr
real(kind=8) :: time00
epepbase=energia(47)
escpho=energia(48)
epeppho=energia(49)
+ ecation_nucl=energia(50)
+ ehomology_constr=energia(51)
+ elipbond=energia(52)
+ elipang=energia(53)
+ eliplj=energia(54)
+ elipelec=energia(55)
+ ecat_prottran=energia(56)
+ ecation_protang=energia(57)
+ elipidprot=energia(58)
! ecations_prot_amber=energia(50)
! energia(41)=ecation_prot
+wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
+wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
+wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
- +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
+ +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho+wcatnucl*ecation_nucl&
+ +(elipbond+elipang+eliplj+elipelec)*wmartini&
+ +wcat_tran*ecat_prottran+ecation_protang&
+ +wlip_prot*elipidprot&
+#ifdef WHAM_RUN
+ +0.0d0
+#else
+ +ehomology_constr
+#endif
#else
etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
+wang*ebe+wtor*etors+wscloc*escloc &
+wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
+wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
+wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
- +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
+ +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho+wcatnucl*ecation_nucl&
+ +(elipbond+elipang+eliplj+elipelec)*wmartini&
+ +wcat_tran*ecat_prottran+ecation_protang&
+ +wlip_prot*elipidprot&
+#ifdef WHAM_RUN
+ +0.0d0
+#else
+ +ehomology_constr
+#endif
#endif
energia(0)=etot
! detecting NaNQ
end subroutine sum_energy
!-----------------------------------------------------------------------------
subroutine rescale_weights(t_bath)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
#ifdef MPI
include 'mpif.h'
#endif
end subroutine rescale_weights
!-----------------------------------------------------------------------------
subroutine enerprint(energia)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.FFIELD'
etube,ethetacnstr,Eafmforce
real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
- ecorr3_nucl
- real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber
+ ecorr3_nucl,ehomology_constr
+ real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,&
+ ecation_nucl,ecat_prottran,ecation_protang
real(kind=8) :: escbase,epepbase,escpho,epeppho
-
+ real(kind=8) :: elipbond,elipang,eliplj,elipelec,elipidprot
etot=energia(0)
evdw=energia(1)
evdw2=energia(2)
epepbase=energia(47)
escpho=energia(48)
epeppho=energia(49)
+ ecation_nucl=energia(50)
+ elipbond=energia(52)
+ elipang=energia(53)
+ eliplj=energia(54)
+ elipelec=energia(55)
+ ecat_prottran=energia(56)
+ ecation_protang=energia(57)
+ ehomology_constr=energia(51)
+ elipidprot=energia(58)
! ecations_prot_amber=energia(50)
#ifdef SPLITELE
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
- ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
+ ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,&
+ ecat_prottran,wcat_tran,ecation_protang,wcat_ang,&
+ ecationcation,wcatcat, &
escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
- etot
+ ecation_nucl,wcatnucl,ehomology_constr,&
+ elipbond,elipang,eliplj,elipelec,elipidprot,wlip_prot,etot
10 format (/'Virtual-chain energies:'// &
'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
+ 'ECATPTRAN=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot tran)'/ &
+ 'ECATPANG=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot angle)'/ &
'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
+ 'ECATBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(cation nucl-base)'/&
+ 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/&
+ 'ELIPBOND=',1pE16.6,'(matrini bond energy)'/&
+ 'ELIPANG=',1pE16.6,'(matrini angle energy)'/&
+ 'ELIPLJ=',1pE16.6,'(matrini Lennard-Jones energy)'/&
+ 'ELIPELEC=',1pE16.6,'(matrini electrostatic energy)'/&
+ 'ELIPPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(lipid prot)'/ &
'ETOT= ',1pE16.6,' (total)')
#else
write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
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,&
- etot
+ ecation_nucl,wcatnucl,ehomology_constr,elipidprot,wlip_prot,etot
10 format (/'Virtual-chain energies:'// &
'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
+ 'ECATBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(cation nucl-base)'/&
+ 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/&
+ 'ELIPBOND=',1pE16.6,'(matrini bond energy)'/&
+ 'ELIPANG=',1pE16.6,'(matrini angle energy)'/&
+ 'ELIPLJ=',1pE16.6,'(matrini Lennard-Jones energy)'/&
+ 'ELIPELEC=',1pE16.6,'(matrini electrostatic energy)'/&
+ 'ELIPPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(lipid prot)'/ &
'ETOT= ',1pE16.6,' (total)')
#endif
return
! This subroutine calculates the interaction energy of nonbonded side chains
! assuming the LJ potential of interaction.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
real(kind=8),parameter :: accur=1.0d-10
! include 'COMMON.GEO'
integer :: num_conti
!el local variables
integer :: i,itypi,iint,j,itypi1,itypj,k
- real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
+ real(kind=8) :: rij,rcut,fcont,fprimcont,rrij,sslipi,ssgradlipi,&
+ aa,bb,sslipj,ssgradlipj
real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
! Change 12/1/95
num_conti=0
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
! Change 12/1/95 to calculate four-body interactions
rij=xj*xj+yj*yj+zj*zj
rrij=1.0D0/rij
! This subroutine calculates the interaction energy of nonbonded side chains
! assuming the LJK potential of interaction.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
logical :: scheck
!el local variables
integer :: i,iint,j,itypi,itypi1,k,itypj
- real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
+ real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij, &
+ sslipi,ssgradlipi, sslipj,ssgradlipj, aa, bb
real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
!
! Calculate SC interaction energy.
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
fac_augm=rrij**expon
e_augm=augm(itypi,itypj)*fac_augm
!
use comm_srutu
use calc_data
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
logical :: lprn
!el local variables
integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi
+ real(kind=8) :: rrij,xi,yi,zi, sslipi,ssgradlipi, sslipj, &
+ ssgradlipj, aa, bb
real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
! assuming the Gay-Berne potential of interaction.
!
use calc_data
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
! include 'COMMON.SBRIDGE'
logical :: lprn
!el local variables
- integer :: iint,itypi,itypi1,itypj,subchap
+ integer :: iint,itypi,itypi1,itypj,subchap,icont,countss
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0ij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
lprn=.false.
+ countss=0
! if (icall.eq.0) lprn=.false.
!el ind=0
dCAVdOM2=0.0d0
dCAVdOM1=0.0d0
dGCLdOM1=0.0d0
dPOLdOM1=0.0d0
-
-
- do i=iatsc_s,iatsc_e
+! write (iout,*) "RWA", g_listscsc_start,g_listscsc_end,i,j
+ if (nres_molec(1).eq.0) return
+ do icont=g_listscsc_start,g_listscsc_end
+ i=newcontlisti(icont)
+ j=newcontlistj(icont)
+! write (iout,*) "RWA", g_listscsc_start,g_listscsc_end,i,j
+! do i=iatsc_s,iatsc_e
!C print *,"I am in EVDW",i
itypi=iabs(itype(i,1))
! if (i.ne.47) cycle
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
- xi=dmod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=dmod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=dmod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-! print *, sslipi,ssgradlipi
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
!
! Calculate SC interaction energy.
!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
+! do iint=1,nint_gr(i)
+! do j=istart(i,iint),iend(i,iint)
IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
- call dyn_ssbond_ene(i,j,evdwij)
+ countss=countss+1
+ call dyn_ssbond_ene(i,j,evdwij,countss)
evdw=evdw+evdwij
if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
'evdw',i,j,evdwij,' ss'
! if (energy_dec) write (iout,*) &
! 'evdw',i,j,evdwij,' ss'
- do k=j+1,iend(i,iint)
+ do k=j+1,nres
!C search over all next residues
if (dyn_ss_mask(k)) then
!C check if they are cysteins
xj=c(1,nres+j)
yj=c(2,nres+j)
zj=c(3,nres+j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
-! print *,"tu",xi,yi,zi,xj,yj,zj
-! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
-! this fragment set correct epsilon for lipid phase
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-!------------------------------------------------
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! write (iout,*) "KWA2", itypi,itypj
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
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
! Calculate angular part of the gradient.
call sc_grad
ENDIF ! dyn_ss
- enddo ! j
- enddo ! iint
+! enddo ! j
+! enddo ! iint
enddo ! i
! print *,"ZALAMKA", evdw
! write (iout,*) "Number of loop steps in EGB:",ind
!
use comm_srutu
use calc_data
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
logical :: lprn
!el local variables
integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
+ real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2, &
+ sigm,sslipi,ssgradlipi, sslipj,ssgradlipj, aa, bb
real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
! This subroutine calculates the interaction energy of nonbonded side chains
! assuming the LJ potential of interaction.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
real(kind=8),parameter :: accur=1.0d-10
! include 'COMMON.GEO'
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+
!
! Calculate SC interaction energy.
!
do j=istart(i,iint),iend(i,iint)
itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
+ xj=boxshift(c(1,nres+j)-xi,boxxsize)
+ yj=boxshift(c(2,nres+j)-yi,boxysize)
+ zj=boxshift(c(3,nres+j)-zi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
r0ij=r0(itypi,itypj)
!
! Soft-sphere potential of p-p interaction
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CONTROL'
! include 'COMMON.IOUNITS'
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
+ call to_box(xmedi,ymedi,zmedi)
num_conti=0
! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
do j=ielstart(i),ielend(i)
xj=c(1,j)+0.5D0*dxj-xmedi
yj=c(2,j)+0.5D0*dyj-ymedi
zj=c(3,j)+0.5D0*dzj-zmedi
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
if (rij.lt.r0ijsq) then
evdw1ij=0.25d0*(rij-r0ijsq)**2
end subroutine eelec_soft_sphere
!-----------------------------------------------------------------------------
subroutine vec_and_deriv
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
end subroutine vec_and_deriv
!-----------------------------------------------------------------------------
subroutine check_vecgrad
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.GEO'
end subroutine check_vecgrad
!-----------------------------------------------------------------------------
subroutine set_matrices
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
! include 'COMMON.VECTORS'
! include 'COMMON.FFIELD'
real(kind=8) :: auxvec(2),auxmat(2,2)
- integer :: i,iti1,iti,k,l
+ 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
-! write(iout,*) "i,",molnum(i)
+ if (i.gt. innt+2 .and. i.lt.inct+2) then
+! write(iout,*) "i,",molnum(i),nloctyp
! print *, "i,",molnum(i),i,itype(i-2,1)
if (molnum(i).eq.1) then
+ if (itype(i-2,1).eq.ntyp1) then
+ iti=nloctyp
+ else
iti = itype2loc(itype(i-2,1))
+ endif
else
iti=nloctyp
endif
#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
0.0d0,1.0d0,0.0d0,&
0.0d0,0.0d0,1.0d0/),shape(unmat))
!el local variables
- integer :: i,k,j
+ integer :: i,k,j,icont
real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
real(kind=8) :: fac,t_eelecij,fracinbuf
eel_loc=0.0d0
eello_turn3=0.0d0
eello_turn4=0.0d0
+ if (nres_molec(1).eq.0) return
!
if (icheckgrad.eq.1) then
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
num_conti=0
- if ((zmedi.gt.bordlipbot) &
- .and.(zmedi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zmedi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zmedi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zmedi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-! print *,i,sslipi,ssgradlipi
call eelecij(i,i+2,ees,evdw1,eel_loc)
if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
num_cont_hb(i)=num_conti
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
- if ((zmedi.gt.bordlipbot) &
- .and.(zmedi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zmedi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zmedi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zmedi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
num_conti=num_cont_hb(i)
call eelecij(i,i+3,ees,evdw1,eel_loc)
if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
- call eturn4(i,eello_turn4)
+ call eturn4(i,eello_turn4)
! print *,"before",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
num_cont_hb(i)=num_conti
enddo ! i
! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
!
! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
- do i=iatel_s,iatel_e
+! do i=iatel_s,iatel_e
+! JPRDLC
+ do icont=g_listpp_start,g_listpp_end
+ i=newcontlistppi(icont)
+ j=newcontlistppj(icont)
if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
dxi=dc(1,i)
dyi=dc(2,i)
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
- if ((zmedi.gt.bordlipbot) &
- .and.(zmedi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zmedi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zmedi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zmedi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
num_conti=num_cont_hb(i)
- do j=ielstart(i),ielend(i)
+! do j=ielstart(i),ielend(i)
! write (iout,*) i,j,itype(i,1),itype(j,1)
if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
call eelecij(i,j,ees,evdw1,eel_loc)
- enddo ! j
+! enddo ! j
num_cont_hb(i)=num_conti
enddo ! i
! write (iout,*) "Number of loop steps in EELEC:",ind
subroutine eelecij(i,j,ees,evdw1,eel_loc)
use comm_locel
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
!el local variables
integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
+ real(kind=8) :: faclipij2, faclipij
real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
xj=c(1,j)+0.5D0*dxj
yj=c(2,j)+0.5D0*dyj
zj=c(3,j)+0.5D0*dzj
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- isubchap=0
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- isubchap=1
- endif
- enddo
- enddo
- enddo
- if (isubchap.eq.1) then
-!C print *,i,j
- xj=xj_temp-xmedi
- yj=yj_temp-ymedi
- zj=zj_temp-zmedi
- else
- xj=xj_safe-xmedi
- yj=yj_safe-ymedi
- zj=zj_safe-zmedi
- endif
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
rrmij=1.0D0/rij
! sss_ele_grad=0.0d0
! print *,sss_ele_cut,sss_ele_grad,&
! (rij),r_cut_ele,rlamb_ele
-! if (sss_ele_cut.le.0.0) go to 128
+ if (sss_ele_cut.le.0.0) go to 128
rmij=1.0D0/rij
r3ij=rrmij*rmij
!grad enddo
!grad enddo
! 9/28/08 AL Gradient compotents will be summed only at the end
- ggg(1)=facvdw*xj &
+ ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
- ggg(2)=facvdw*yj &
+ ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
- ggg(3)=facvdw*zj &
+ ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
do k=1,3
+a32*gmuij1(3)&
+a33*gmuij1(4))&
*fac_shield(i)*fac_shield(j)&
- *sss_ele_cut
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
!c write(iout,*) "derivative over thatai"
!c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+&
geel_loc_ij*wel_loc&
*fac_shield(i)*fac_shield(j)&
- *sss_ele_cut
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
!c Derivative over j residue
gloc(nphi+j,icg)=gloc(nphi+j,icg)+&
geel_loc_ji*wel_loc&
*fac_shield(i)*fac_shield(j)&
- *sss_ele_cut
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
geel_loc_ji=&
gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+&
geel_loc_ji*wel_loc&
*fac_shield(i)*fac_shield(j)&
- *sss_ele_cut
+ *sss_ele_cut &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
#endif
! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
*sss_ele_cut &
*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
*sss_ele_cut &
*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
! Diagnostics. Comment out or remove after debugging!
! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
gacontp_hb1(k,num_conti,i)= & !ghalfp+
(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
+ ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
- *sss_ele_cut*fac_shield(i)*fac_shield(j)
+ *sss_ele_cut*fac_shield(i)*fac_shield(j) ! &
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
gacontp_hb2(k,num_conti,i)= & !ghalfp+
(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
+ ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
- *sss_ele_cut*fac_shield(i)*fac_shield(j)
+ *sss_ele_cut*fac_shield(i)*fac_shield(j)! &
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
gacontp_hb3(k,num_conti,i)=gggp(k) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
gacontm_hb1(k,num_conti,i)= & !ghalfm+
(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
+ ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
gacontm_hb2(k,num_conti,i)= & !ghalfm+
(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
+ ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
gacontm_hb3(k,num_conti,i)=gggm(k) &
*sss_ele_cut*fac_shield(i)*fac_shield(j)
+! *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
enddo
! Diagnostics. Comment out or remove after debugging!
! Third- and fourth-order contributions from turns
use comm_locel
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.GEO'
!el num_conti,j1,j2
!el local variables
integer :: i,j,l,k,ilist,iresshield
- real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
-
+ real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield,xj,yj
+ xj=0.0d0
+ yj=0.0d0
j=i+2
! write (iout,*) "eturn3",i,j,j1,j2
zj=(c(3,j)+c(3,j+1))/2.0d0
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.lt.0)) write (*,*) "CHUJ"
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
a_temp(1,1)=a22
a_temp(1,2)=a23
!C Derivatives in theta
gloc(nphi+i,icg)=gloc(nphi+i,icg) &
+0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3&
- *fac_shield(i)*fac_shield(j)
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)&
+0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3&
- *fac_shield(i)*fac_shield(j)
+ *fac_shield(i)*fac_shield(j) &
+ *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
+
!C#endif
! 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'
!el local variables
integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
- rlocshield,gs23,gs32,gsE13,gs13,gs21,gsE31,gsEE1,gsEE2,gsEE3
-
+ rlocshield,gs23,gs32,gsE13,gs13,gs21,gsE31,gsEE1,gsEE2,gsEE3,xj,yj
+ xj=0.0d0
+ yj=0.0d0
j=i+3
! if (j.ne.20) return
! print *,i,j,gshieldc_t4(2,j),gshieldc_t4(2,j+1)
!d call checkint_turn4(i,a_temp,eello_turn4_num)
! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
zj=(c(3,j)+c(3,j+1))/2.0d0
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+
a_temp(1,1)=a22
a_temp(1,2)=a23
#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'
xi=0.5D0*(c(1,i)+c(1,i+1))
yi=0.5D0*(c(2,i)+c(2,i+1))
zi=0.5D0*(c(3,i)+c(3,i+1))
+ call to_box(xi,yi,zi)
do iint=1,nscp_gr(i)
xj=c(1,j)-xi
yj=c(2,j)-yi
zj=c(3,j)-zi
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
r0ij=r0_scp
r0ijsq=r0ij*r0ij
! peptide-group centers and side chains and its gradient in virtual-bond and
! side-chain vectors.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
! include 'COMMON.CONTROL'
real(kind=8),dimension(3) :: ggg
!el local variables
- integer :: i,iint,j,k,iteli,itypj,subchap
+ integer :: i,iint,j,k,iteli,itypj,subchap,iconta
real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
e1,e2,evdwij,rij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
evdw2_14=0.0d0
!d print '(a)','Enter ESCP'
!d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
- do i=iatscp_s,iatscp_e
+! do i=iatscp_s,iatscp_e
+ if (nres_molec(1).eq.0) return
+ do iconta=g_listscp_start,g_listscp_end
+! print *,"icont",iconta,g_listscp_start,g_listscp_end
+ i=newcontlistscpi(iconta)
+ j=newcontlistscpj(iconta)
if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
iteli=itel(i)
xi=0.5D0*(c(1,i)+c(1,i+1))
yi=0.5D0*(c(2,i)+c(2,i+1))
zi=0.5D0*(c(3,i)+c(3,i+1))
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- do iint=1,nscp_gr(i)
+ call to_box(xi,yi,zi)
+! print *,itel(i),i,j
+! do iint=1,nscp_gr(i)
- do j=iscpstart(i,iint),iscpend(i,iint)
+! do j=iscpstart(i,iint),iscpend(i,iint)
itypj=iabs(itype(j,1))
if (itypj.eq.ntyp1) cycle
! Uncomment following three lines for SC-p interactions
xj=c(1,j)
yj=c(2,j)
zj=c(3,j)
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(1.0d0/rrij)
gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
enddo
- enddo
+! enddo
- enddo ! iint
+! enddo ! iint
enddo ! i
do i=1,nct
do j=1,3
!
! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.SBRIDGE'
! include 'COMMON.CHAIN'
! include 'COMMON.VAR'
! include 'COMMON.INTERACT'
! include 'COMMON.IOUNITS'
- real(kind=8),dimension(3) :: ggg
+ real(kind=8),dimension(3) :: ggg,vec
!el local variables
- integer :: i,j,ii,jj,iii,jjj,k
- real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
+ integer :: i,j,ii,jj,iii,jjj,k,mnumii,mnumjj
+ real(kind=8) :: fac,eij,rdis,ehpb,dd,waga,xi,yi,zi,zj,yj,xj
ehpb=0.0D0
-!d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
-!d write(iout,*)'link_start=',link_start,' link_end=',link_end
+! write(iout,*)'edis: nhpb=',nhpb!,' fbr=',fbr
+! write(iout,*)'link_start=',link_start,' link_end=',link_end
if (link_end.eq.0) return
do i=link_start,link_end
! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
! CA-CA distance used in regularization of structure.
+
ii=ihpb(i)
jj=jhpb(i)
! iii and jjj point to the residues for which the distance is assigned.
iii=ii
jjj=jj
endif
+ do j=1,3
+ vec(j)=c(j,jj)-c(j,ii)
+ enddo
+ mnumii=molnum(iii)
+ mnumjj=molnum(jjj)
+ if (energy_dec) write(iout,*) i,ii,jj,mnumii,mnumjj,itype(jjj,mnumjj),itype(iii,mnumii)
+ if ((itype(iii,mnumii).gt.ntyp_molec(mnumii)).or.(itype(jjj,mnumjj).gt.ntyp_molec(mnumjj))) cycle
+
! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
! & dhpb(i),dhpb1(i),forcon(i)
! 24/11/03 AL: SS bridges handled separately because of introducing a specific
iabs(itype(jjj,1)).eq.1) then
call ssbond_ene(iii,jjj,eij)
ehpb=ehpb+2*eij
-!d write (iout,*) "eij",eij
+! write (iout,*) "eij",eij,iii,jjj
endif
else if (ii.gt.nres .and. jj.gt.nres) then
!c Restraints from contact prediction
enddo
else
dd=dist(ii,jj)
+
if (constr_dist.eq.11) then
ehpb=ehpb+fordepth(i)**4.0d0 &
*rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
!c write (iout,*) "alph nmr",
!c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
else
+ xi=c(1,ii)
+ yi=c(2,ii)
+ zi=c(3,ii)
+ call to_box(xi,yi,zi)
+ xj=c(1,jj)
+ yj=c(2,jj)
+ zj=c(3,jj)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ vec(1)=xj
+ vec(2)=yj
+ vec(3)=zj
+ dd=sqrt(xj*xj+yj*yj+zj*zj)
rdis=dd-dhpb(i)
!C Get the force constant corresponding to this distance.
waga=forcon(i)
!C Calculate the contribution to energy.
ehpb=ehpb+waga*rdis*rdis
+ if (energy_dec) write (iout,'(a6,2i5,5f10.3)') "edis",ii,jj, &
+ ehpb,dd,dhpb(i),waga,rdis
+
!c write (iout,*) "alpha reg",dd,waga*rdis*rdis
!C
!C Evaluate gradient.
endif
do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
+ ggg(j)=fac*vec(j)
enddo
!cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
!C If this is a SC-SC distance, we need to calculate the contributions to the
!
! A. Liwo and U. Kozlowska, 11/24/03
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.SBRIDGE'
! include 'COMMON.CHAIN'
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
itypj=iabs(itype(j,1))
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(nres+j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
+akct*deltad*deltat12 &
+v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
-! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
-! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
-! & " deltat12",deltat12," eij",eij
+! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, &
+! " akct",akct," deltad",deltad," deltat",deltat1,deltat2, &
+! " deltat12",deltat12," eij",eij
ed=2*akcm*deltad+akct*deltat12
pom1=akct*deltad
pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
!
! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.LOCAL'
! include 'COMMON.GEO'
! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
do i=ibondp_start,ibondp_end
+#ifdef FIVEDIAG
+ if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) cycle
+ diff = vbld(i)-vbldp0
+#else
if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
!C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
else
diff = vbld(i)-vbldp0
endif
+#endif
if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
"estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
estr=estr+diff*diff
! angles gamma and its derivatives in consecutive thetas and gammas.
!
use comm_calcthet
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.LOCAL'
! include 'COMMON.GEO'
subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
use comm_calcthet
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.LOCAL'
! include 'COMMON.IOUNITS'
! 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
! & dscp1,dscp2,sumene
! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
escloc = escloc + sumene
+ if (energy_dec) write (2,*) "i",i," itype",itype(i,1)," it",it, &
+ " escloc",sumene,escloc,it,itype(i,1)
! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
! & ,zz,xx,yy
!#define DEBUG
! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
! to check gradient call subroutine check_grad
-
+#ifdef SC_END
+ endif
+#endif
1 continue
enddo
return
end subroutine gcont
!-----------------------------------------------------------------------------
subroutine splinthet(theti,delta,ss,ssder)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
#ifdef CRYST_TOR
!-----------------------------------------------------------------------------
subroutine etor(etors,edihcnstr)
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
etors_d=0.0d0
return
end subroutine etor_d
+!-----------------------------------------------------------------------------
+!c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
+ subroutine e_modeller(ehomology_constr)
+ real(kind=8) :: ehomology_constr
+ ehomology_constr=0.0d0
+ write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
+ return
+ end subroutine e_modeller
+C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
#else
!-----------------------------------------------------------------------------
subroutine etor(etors)
-! 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'
+!
+
+
+ do i=1,max_template
+ distancek(i)=9999999.9
+ enddo
+
+
+ odleg=0.0d0
+
+! 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
+
+! 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
+! write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
+! write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
+#ifdef DEBUG
+ write (iout,*) "i",i," betai",betai," kat2",kat2
+ write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
+#endif
+ if (kat2.le.1.0d-14) cycle
+ kat=kat-dLOG(kat2/constr_homology)
+! write (iout,*) "kat",kat ! sum of -ln-s
+
+!cc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
+!cc & dLOG(kat2), "-kat=", -kat
+
+! ----------------------------------------------------------------------
+! Gradient
+! ----------------------------------------------------------------------
+
+ sum_gdih=kat2
+ sum_sgdih=0.0d0
+ do k=1,constr_homology
+#ifdef OLD_DIHED
+ sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
+#else
+ sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i) ! waga_angle rmvd
+#endif
+! sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
+ sum_sgdih=sum_sgdih+sgdih
+ enddo
+! grad_dih3=sum_sgdih/sum_gdih
+ grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih
+! print *, "ok3"
+
+! write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
+!cc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
+!cc & gloc(nphi+i-3,icg)
+ gloc(i-3,icg)=gloc(i-3,icg)+grad_dih3
+! if (i.eq.25) then
+! write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
+! endif
+!cc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
+!cc & gloc(nphi+i-3,icg)
+
+ enddo ! i-loop for dih
+#ifdef DEBUG
+ write(iout,*) "------- dih restrs end -------"
+#endif
+
+! Pseudo-energy and gradient for theta angle restraints from
+! homology templates
+! FP 01/15 - inserted from econstr_local_test.F, loop structure
+! adapted
+
+!
+! For constr_homology reference structures (FP)
+!
+! Uconst_back_tot=0.0d0
+ Eval=0.0d0
+ Erot=0.0d0
+! Econstr_back legacy
+ do i=1,nres
+! do i=ithet_start,ithet_end
+ dutheta(i)=0.0d0
+ enddo
+! do i=loc_start,loc_end
+ do i=-1,nres
+ do j=1,3
+ duscdiff(j,i)=0.0d0
+ duscdiffx(j,i)=0.0d0
+ enddo
+ enddo
+!
+! 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
+
+ do i=ithet_start,ithet_end
+!
+! do i=1,nfrag_back
+! ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
+!
+! Deviation of theta angles wrt constr_homology ref structures
+!
+ utheta_i=0.0d0 ! argument of Gaussian for single k
+ gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures
+! do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop
+! over residues in a fragment
+! write (iout,*) "theta(",i,")=",theta(i)
+ do k=1,constr_homology
+!
+! dtheta_i=theta(j)-thetaref(j,iref)
+! dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing
+ theta_diff(k)=thetatpl(k,i)-theta(i)
+!d write (iout,'(a8,2i4,2f15.8)') "theta_diff",i,k,theta_diff(k)
+!d & ,sigma_theta(k,i)
+
+!
+ utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
+! utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
+ gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
+ gutheta_i=gutheta_i+gtheta(k) ! Sum of Gaussians (pk)
+! Gradient for single Gaussian restraint in subr Econstr_back
+! dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
+!
+ enddo
+! write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps
+! write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps
+
+!
+! Gradient for multiple Gaussian restraint
+ sum_gtheta=gutheta_i
+ sum_sgtheta=0.0d0
+ do k=1,constr_homology
+! New generalized expr for multiple Gaussian from Econstr_back
+ sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd
+!
+! sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form?
+ sum_sgtheta=sum_sgtheta+sgtheta ! cum variable
+ enddo
+! Final value of gradient using same var as in Econstr_back
+ gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg) &
+ +sum_sgtheta/sum_gtheta*waga_theta &
+ *waga_homology(iset)
+! print *, "ok4"
+
+! dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta
+! & *waga_homology(iset)
+! dutheta(i)=sum_sgtheta/sum_gtheta
+!
+! Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight
+ Eval=Eval-dLOG(gutheta_i/constr_homology)
+! write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps
+! write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s
+! Uconst_back=Uconst_back+utheta(i)
+ enddo ! (i-loop for theta)
+#ifdef DEBUG
+ write(iout,*) "------- theta restrs end -------"
+#endif
+ endif
+!
+! 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
+#endif
+ do i=loc_start,loc_end
+ usc_diff_i=0.0d0 ! argument of Gaussian for single k
+ guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures
+! do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy
+! write(iout,*) "xxtab, yytab, zztab"
+! write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i)
+ do k=1,constr_homology
+!
+ dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
+! Original sign inverted for calc of gradients (s. Econstr_back)
+ dyy=-yytpl(k,i)+yytab(i) ! ibid y
+ dzz=-zztpl(k,i)+zztab(i) ! ibid z
+! write(iout,*) "dxx, dyy, dzz"
+!d write(iout,'(2i5,4f8.2)') k,i,dxx,dyy,dzz,sigma_d(k,i)
+!
+ usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument
+! usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
+! uscdiffk(k)=usc_diff(i)
+ guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
+! write(iout,*) "i",i," k",k," sigma_d",sigma_d(k,i),
+! & " guscdiff2",guscdiff2(k)
+ guscdiff(i)=guscdiff(i)+guscdiff2(k) !Sum of Gaussians (pk)
+! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
+! & xxref(j),yyref(j),zzref(j)
+ enddo
+!
+! Gradient
+!
+! Generalized expression for multiple Gaussian acc to that for a single
+! Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014)
+!
+! Original implementation
+! sum_guscdiff=guscdiff(i)
+!
+! sum_sguscdiff=0.0d0
+! do k=1,constr_homology
+! sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d?
+! sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff
+! sum_sguscdiff=sum_sguscdiff+sguscdiff
+! enddo
+!
+! Implementation of new expressions for gradient (Jan. 2015)
+!
+! grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !?
+ do k=1,constr_homology
+!
+! New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong
+! before. Now the drivatives should be correct
+!
+ dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str?
+! Original sign inverted for calc of gradients (s. Econstr_back)
+ dyy=-yytpl(k,i)+yytab(i) ! ibid y
+ dzz=-zztpl(k,i)+zztab(i) ! ibid z
+ sum_guscdiff=guscdiff2(k)* &!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong!
+ sigma_d(k,i) ! for the grad wrt r'
+! sum_sguscdiff=sum_sguscdiff+sum_guscdiff
+
+!
+! New implementation
+ sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff
+ do jik=1,3
+ duscdiff(jik,i-1)=duscdiff(jik,i-1)+ &
+ sum_guscdiff*(dXX_C1tab(jik,i)*dxx+ &
+ dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i)
+ duscdiff(jik,i)=duscdiff(jik,i)+ &
+ sum_guscdiff*(dXX_Ctab(jik,i)*dxx+ &
+ dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i)
+ duscdiffx(jik,i)=duscdiffx(jik,i)+ &
+ sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+ &
+ dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i)
+! print *, "ok5"
+!
+#ifdef DEBUG
+! write(iout,*) "jik",jik,"i",i
+ write(iout,*) "dxx, dyy, dzz"
+ write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz
+ write(iout,*) "guscdiff2(",k,")",guscdiff2(k)
+ write(iout,*) "sum_sguscdiff",sum_guscdiff,waga_homology(iset),waga_d
+ write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i)
+ write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i)
+ write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i)
+ write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i)
+ write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i)
+ write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i)
+ write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i)
+ write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i)
+ write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i)
+ write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1)
+ write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i)
+ write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i)
+! endif
+#endif
+ enddo
+ enddo
+! print *, "ok6"
+!
+! uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required?
+! usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ?
+!
+! write (iout,*) i," uscdiff",uscdiff(i)
+!
+! Put together deviations from local geometry
+
+! Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
+! & wfrag_back(3,i,iset)*uscdiff(i)
+ Erot=Erot-dLOG(guscdiff(i)/constr_homology)
+! write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps
+! write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s
+! Uconst_back=Uconst_back+usc_diff(i)
+!
+! Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?)
+!
+! New implment: multiplied by sum_sguscdiff
+!
+
+ enddo ! (i-loop for dscdiff)
+
+! endif
+
+#ifdef DEBUG
+ write(iout,*) "------- SC restrs end -------"
+ write (iout,*) "------ After SC loop in e_modeller ------"
+ do i=loc_start,loc_end
+ write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
+ write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
+ enddo
+ if (waga_theta.eq.1.0d0) then
+ write (iout,*) "in e_modeller after SC restr end: dutheta"
+ do i=ithet_start,ithet_end
+ write (iout,*) i,dutheta(i)
+ enddo
+ 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
+!
+! 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
! 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)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.VAR'
! include 'COMMON.GEO'
! 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)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
! include 'COMMON.DERIV'
end subroutine multibody
!-----------------------------------------------------------------------------
real(kind=8) function esccorr(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.DERIV'
!-----------------------------------------------------------------------------
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)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.IOUNITS'
#ifdef MPI
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)
+ 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)
+ 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)
+ +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)
+ +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"
enddo
#endif
!#undef DEBUG
- do i=1,nres
+ do i=0,nres
do j=1,3
gloc_scbuf(j,i)=gloc_sc(j,i,icg)
enddo
call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
time_reduce=time_reduce+MPI_Wtime()-time00
- call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
+ call MPI_Reduce(gloc_scbuf(1,0),gloc_sc(1,0,icg),3*nres+3,&
MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
time_reduce=time_reduce+MPI_Wtime()-time00
!#define DEBUG
! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
#ifdef DEBUG
write (iout,*) "gloc_sc after reduce"
- do i=1,nres
+ do i=0,nres
do j=1,1
write (iout,*) i,j,gloc_sc(j,i,icg)
enddo
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
+!SCALINING MARTINI
+ real(kind=8) function sscale_martini(r)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm
+! print *,"here2",r_cut_mart,r
+ if(r.lt.r_cut_mart-rlamb_mart) then
+ sscale_martini=1.0d0
+ else if(r.le.r_cut_mart.and.r.ge.r_cut_mart-rlamb_mart) then
+ gamm=(r-(r_cut_mart-rlamb_mart))/rlamb_mart
+ sscale_martini=1.0d0+gamm*gamm*(2*gamm-3.0d0)
+ else
+ sscale_martini=0.0d0
+ endif
+ return
+ end function sscale_martini
+ real(kind=8) function sscale_grad_martini(r)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm
+ if(r.lt.r_cut_mart-rlamb_mart) then
+ sscale_grad_martini=0.0d0
+ else if(r.le.r_cut_mart.and.r.ge.r_cut_mart-rlamb_mart) then
+ gamm=(r-(r_cut_mart-rlamb_mart))/rlamb_mart
+ sscale_grad_martini=gamm*(6*gamm-6.0d0)/rlamb_mart
+ else
+ sscale_grad_martini=0.0d0
+ endif
+ return
+ end function sscale_grad_martini
+ real(kind=8) function sscale_martini_angle(r)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm,r_cut_angle,rlamb_angle
+! print *,"here2",r_cut_angle,r
+ r_cut_angle=3.12d0
+ rlamb_angle=0.1d0
+ if(r.lt.r_cut_angle-rlamb_angle) then
+ sscale_martini_angle=1.0d0
+ else if(r.le.r_cut_angle.and.r.ge.r_cut_angle-rlamb_angle) then
+ gamm=(r-(r_cut_angle-rlamb_angle))/rlamb_angle
+ sscale_martini_angle=1.0d0+gamm*gamm*(2*gamm-3.0d0)
+ else
+ sscale_martini_angle=0.0d0
+ endif
+ return
+ end function sscale_martini_angle
+ real(kind=8) function sscale_grad_martini_angle(r)
+! include "COMMON.SPLITELE"
+ real(kind=8) :: r,gamm,r_cut_angle,rlamb_angle
+ r_cut_angle=3.12d0
+ rlamb_angle=0.1d0
+ if(r.lt.r_cut_angle-rlamb_angle) then
+ sscale_grad_martini_angle=0.0d0
+ else if(r.le.r_cut_angle.and.r.ge.r_cut_angle-rlamb_angle) then
+ gamm=(r-(r_cut_angle-rlamb_angle))/rlamb_angle
+ sscale_grad_martini_angle=gamm*(6*gamm-6.0d0)/rlamb_angle
+ else
+ sscale_grad_martini_angle=0.0d0
+ endif
+ return
+ end function sscale_grad_martini_angle
+
!!!!!!!!!! PBCSCALE
real(kind=8) function sscale_ele(r)
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'
!el local variables
integer :: i,iint,j,k,itypi,itypi1,itypj
real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
- real(kind=8) :: e1,e2,evdwij,evdw
+ real(kind=8) :: e1,e2,evdwij,evdw,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj,aa,bb
! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
!
! Calculate SC interaction energy.
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
if (sss.lt.1.0d0) then
! 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'
!el local variables
integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
- real(kind=8) :: e1,e2,evdwij,evdw
+ real(kind=8) :: e1,e2,evdwij,evdw,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj
! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
! Change 12/1/95
num_conti=0
!
! 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'
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+
!
! Calculate SC interaction energy.
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
fac_augm=rrij**expon
e_augm=augm(itypi,itypj)*fac_augm
! 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'
!el local variables
integer :: i,iint,j,k,itypi,itypi1,itypj
real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
- fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
+ fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij,&
+ sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
!
! Calculate SC interaction energy.
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
fac_augm=rrij**expon
e_augm=augm(itypi,itypj)*fac_augm
return
end subroutine eljk_short
!-----------------------------------------------------------------------------
- subroutine ebp_long(evdw)
-!
+ subroutine ebp_long(evdw)
! This subroutine calculates the interaction energy of nonbonded side chains
! assuming the Berne-Pechukas potential of interaction.
!
- use calc_data
-! implicit real*8 (a-h,o-z)
+ use calc_data
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
! include 'COMMON.INTERACT'
! include 'COMMON.IOUNITS'
! include 'COMMON.CALC'
- use comm_srutu
+ use comm_srutu
!el integer :: icall
!el common /srutu/ icall
! double precision rrsave(maxdim)
- logical :: lprn
+ logical :: lprn
!el local variables
- integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac
- real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
- evdw=0.0D0
+ integer :: iint,itypi,itypi1,itypj
+ real(kind=8) :: rrij,xi,yi,zi,fac,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj,aa,bb
+ real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
+ evdw=0.0D0
! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
+ evdw=0.0D0
! if (icall.eq.0) then
! lprn=.true.
! else
- lprn=.false.
+ lprn=.false.
! endif
!el ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
+ itypi=itype(i,1)
+ if (itypi.eq.ntyp1) cycle
+ itypi1=itype(i+1,1)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+! dsci_inv=dsc_inv(itypi)
+ dsci_inv=vbld_inv(i+nres)
+!
+! Calculate SC interaction energy.
+!
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
+!el ind=ind+1
+ itypj=itype(j,1)
+ if (itypj.eq.ntyp1) cycle
+! dscj_inv=dsc_inv(itypj)
+ dscj_inv=vbld_inv(j+nres)
+!chi1=chi(itypi,itypj)
+!chi2=chi(itypj,itypi)
+!chi12=chi1*chi2
+!chip1=chip(itypi)
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij)
+ sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
+
+ if (sss.lt.1.0d0) then
+
+ ! Calculate the angle-dependent terms of energy & contributions to derivatives.
+ call sc_angular
+ ! Calculate whole angle-dependent part of epsilon and contributions
+ ! to its derivatives
+ fac=(rrij*sigsq)**expon2
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
+ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+ eps2der=evdwij*eps3rt
+ eps3der=evdwij*eps2rt
+ evdwij=evdwij*eps2rt*eps3rt
+ evdw=evdw+evdwij*(1.0d0-sss)
+ if (lprn) then
+ sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
+ !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
+ !d & restyp(itypi,1),i,restyp(itypj,1),j,
+ !d & epsi,sigm,chi1,chi2,chip1,chip2,
+ !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
+ !d & om1,om2,om12,1.0D0/dsqrt(rrij),
+ !d & evdwij
+ endif
+ ! Calculate gradient components.
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ fac=-expon*(e1+evdwij)
+ sigder=fac/sigsq
+ fac=rrij*fac
+ ! Calculate radial part of the gradient
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
+ ! Calculate the angular part of the gradient and sum add the contributions
+ ! to the appropriate components of the Cartesian gradient.
+ call sc_grad_scale(1.0d0-sss)
+ endif
+ enddo ! j
+ enddo ! iint
+ enddo ! i
+ ! stop
+ return
+ end subroutine ebp_long
+ !-----------------------------------------------------------------------------
+ subroutine ebp_short(evdw)
+ !
+ ! This subroutine calculates the interaction energy of nonbonded side chains
+ ! assuming the Berne-Pechukas potential of interaction.
+ !
+ use calc_data
+! implicit real(kind=8) (a-h,o-z)
+ ! include 'DIMENSIONS'
+ ! include 'COMMON.GEO'
+ ! include 'COMMON.VAR'
+ ! include 'COMMON.LOCAL'
+ ! include 'COMMON.CHAIN'
+ ! include 'COMMON.DERIV'
+ ! include 'COMMON.NAMES'
+ ! include 'COMMON.INTERACT'
+ ! include 'COMMON.IOUNITS'
+ ! include 'COMMON.CALC'
+ use comm_srutu
+ !el integer :: icall
+ !el common /srutu/ icall
+! double precision rrsave(maxdim)
+ logical :: lprn
+ !el local variables
+ integer :: iint,itypi,itypi1,itypj
+ real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
+ real(kind=8) :: sss,e1,e2,evdw,aa,bb, &
+ sslipi,ssgradlipi,sslipj,ssgradlipj
+ evdw=0.0D0
+ ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
+ evdw=0.0D0
+ ! if (icall.eq.0) then
+ ! lprn=.true.
+ ! else
+ lprn=.false.
+ ! endif
+ !el ind=0
+ do i=iatsc_s,iatsc_e
+ itypi=itype(i,1)
if (itypi.eq.ntyp1) cycle
itypi1=itype(i+1,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
-! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-!
-! Calculate SC interaction energy.
-!
+ ! dsci_inv=dsc_inv(itypi)
+ dsci_inv=vbld_inv(i+nres)
+ !
+ ! Calculate SC interaction energy.
+ !
do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
-!el ind=ind+1
- itypj=itype(j,1)
- if (itypj.eq.ntyp1) cycle
-! dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
+ do j=istart(i,iint),iend(i,iint)
+ !el ind=ind+1
+ itypj=itype(j,1)
+ if (itypj.eq.ntyp1) cycle
+ ! dscj_inv=dsc_inv(itypj)
+ dscj_inv=vbld_inv(j+nres)
+ chi1=chi(itypi,itypj)
+ chi2=chi(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip(itypi)
+ chip2=chip(itypj)
+ chip12=chip1*chip2
+ alf1=alp(itypi)
+ alf2=alp(itypj)
+ alf12=0.5D0*(alf1+alf2)
+ xj=c(1,nres+j)-xi
+ yj=c(2,nres+j)-yi
+ zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
rij=dsqrt(rrij)
sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
- if (sss.lt.1.0d0) then
+ if (sss.gt.0.0d0) then
! Calculate the angle-dependent terms of energy & contributions to derivatives.
call sc_angular
eps2der=evdwij*eps3rt
eps3der=evdwij*eps2rt
evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*(1.0d0-sss)
+ evdw=evdw+evdwij*sss
if (lprn) then
sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
gg(3)=zj*fac
! Calculate the angular part of the gradient and sum add the contributions
! to the appropriate components of the Cartesian gradient.
- call sc_grad_scale(1.0d0-sss)
+ call sc_grad_scale(sss)
endif
enddo ! j
enddo ! iint
enddo ! i
! stop
return
- end subroutine ebp_long
+ end subroutine ebp_short
!-----------------------------------------------------------------------------
- subroutine ebp_short(evdw)
+ subroutine egb_long(evdw)
!
! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the Berne-Pechukas potential of interaction.
+! 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.INTERACT'
! include 'COMMON.IOUNITS'
! include 'COMMON.CALC'
- use comm_srutu
-!el integer :: icall
-!el common /srutu/ icall
-! double precision rrsave(maxdim)
+! include 'COMMON.CONTROL'
logical :: lprn
!el local variables
- integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
- real(kind=8) :: sss,e1,e2,evdw
+ integer :: iint,itypi,itypi1,itypj,subchap
+ real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
+ real(kind=8) :: sss,e1,e2,evdw,sss_grad
+ real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+ dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
+ ssgradlipi,ssgradlipj
+
+
evdw=0.0D0
-! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
+!cccc energy_dec=.false.
+! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
-! if (icall.eq.0) then
-! lprn=.true.
-! else
- lprn=.false.
-! endif
+ lprn=.false.
+! if (icall.eq.0) lprn=.false.
!el ind=0
do i=iatsc_s,iatsc_e
itypi=itype(i,1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
! dsci_inv=dsc_inv(itypi)
dsci_inv=vbld_inv(i+nres)
-!
-! Calculate SC interaction energy.
-!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
-!el ind=ind+1
- itypj=itype(j,1)
- if (itypj.eq.ntyp1) cycle
-! dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.gt.0.0d0) then
-
-! Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-! Calculate whole angle-dependent part of epsilon and contributions
-! to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa_aq(itypi,itypj)
- e2=fac*bb_aq(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*sss
- if (lprn) then
- sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
-!d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-!d & restyp(itypi,1),i,restyp(itypj,1),j,
-!d & epsi,sigm,chi1,chi2,chip1,chip2,
-!d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-!d & om1,om2,om12,1.0D0/dsqrt(rrij),
-!d & evdwij
- endif
-! Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-! Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-! Calculate the angular part of the gradient and sum add the contributions
-! to the appropriate components of the Cartesian gradient.
- call sc_grad_scale(sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-! stop
- return
- end subroutine ebp_short
-!-----------------------------------------------------------------------------
- subroutine egb_long(evdw)
-!
-! This subroutine calculates the interaction energy of nonbonded side chains
-! assuming the Gay-Berne potential of interaction.
-!
- use calc_data
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.NAMES'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CALC'
-! include 'COMMON.CONTROL'
- logical :: lprn
-!el local variables
- integer :: iint,itypi,itypi1,itypj,subchap
- real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
- real(kind=8) :: sss,e1,e2,evdw,sss_grad
- real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
- ssgradlipi,ssgradlipj
-
-
- evdw=0.0D0
-!cccc energy_dec=.false.
-! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-! if (icall.eq.0) lprn=.false.
-!el ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i,1)
- if (itypi.eq.ntyp1) cycle
- itypi1=itype(i+1,1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
-
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
+! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
+! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
!
! Calculate SC interaction energy.
!
yj=c(2,nres+j)
zj=c(3,nres+j)
! Searching for nearest neighbour
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
-
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
! 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
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
! dsci_inv=dsc_inv(itypi)
dsci_inv=vbld_inv(i+nres)
-! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-!
-! Calculate SC interaction energy.
-!
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
- 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'
'evdw',i,j,evdwij,'tss'
endif!dyn_ss_mask(k)
enddo! k
-
-! if (energy_dec) write (iout,*) &
-! 'evdw',i,j,evdwij,' ss'
ELSE
-!el ind=ind+1
- itypj=itype(j,1)
+
+! typj=itype(j,1)
if (itypj.eq.ntyp1) cycle
! dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
+ dscj_inv=dsc_inv(itypj)
! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
! & 1.0d0/vbld(j+nres)
! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
yj=c(2,nres+j)
zj=c(3,nres+j)
! Searching for nearest neighbour
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- if ((zj.gt.bordlipbot) &
- .and.(zj.lt.bordliptop)) then
-!C the energy transfer exist
- if (zj.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zj-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zj.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
- sslipj=sscalelip(fracinbuf)
- ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipj=1.0d0
- ssgradlipj=0.0
- endif
- else
- sslipj=0.0d0
- ssgradlipj=0.0
- endif
- aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
- bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
- +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
-
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
! 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'
logical :: lprn
!el local variables
integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
+ real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij,&
+ sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
evdw=0.0D0
! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
+
! dsci_inv=dsc_inv(itypi)
dsci_inv=vbld_inv(i+nres)
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
! 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'
logical :: lprn
!el local variables
integer :: iint,itypi,itypi1,itypj
- real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
+ real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift,&
+ sslipi,ssgradlipi, sslipj,ssgradlipj,aa,bb
real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
evdw=0.0D0
! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
dxi=dc_norm(1,nres+i)
dyi=dc_norm(2,nres+i)
dzi=dc_norm(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
! dsci_inv=dsc_inv(itypi)
dsci_inv=vbld_inv(i+nres)
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
! 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
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
num_conti=0
call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
+
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+
num_conti=num_cont_hb(i)
call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
num_conti=num_cont_hb(i)
do j=ielstart(i),ielend(i)
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'
ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
- ecosam,ecosbm,ecosgm,ghalf,time00
+ ecosam,ecosbm,ecosgm,ghalf,time00,faclipij,faclipij2
! integer :: maxconts
! maxconts = nres/4
! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
xj=c(1,j)+0.5D0*dxj
yj=c(2,j)+0.5D0*dyj
zj=c(3,j)+0.5D0*dzj
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- isubchap=0
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- isubchap=1
- endif
- enddo
- enddo
- enddo
- if (isubchap.eq.1) then
-!C print *,i,j
- xj=xj_temp-xmedi
- yj=yj_temp-ymedi
- zj=zj_temp-zmedi
- else
- xj=xj_safe-xmedi
- yj=yj_safe-ymedi
- zj=zj_safe-zmedi
- endif
-
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
rrmij=1.0D0/rij
rij=dsqrt(rij)
!
! 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'
dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,sss_grad
+ dist_temp, dist_init,sss_grad,sslipi,ssgradlipi,&
+ sslipj,ssgradlipj,faclipij2
integer xshift,yshift,zshift
xmedi=c(1,i)+0.5d0*dxi
ymedi=c(2,i)+0.5d0*dyi
zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
num_conti=0
! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
! & ' ielend',ielend_vdw(i)
xj=c(1,j)+0.5D0*dxj
yj=c(2,j)+0.5D0*dyj
zj=c(3,j)+0.5D0*dzj
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- isubchap=0
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- isubchap=1
- endif
- enddo
- enddo
- enddo
- if (isubchap.eq.1) then
-!C print *,i,j
- xj=xj_temp-xmedi
- yj=yj_temp-ymedi
- zj=zj_temp-zmedi
- else
- xj=xj_safe-xmedi
- yj=yj_safe-ymedi
- zj=zj_safe-zmedi
- endif
-
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
rij=xj*xj+yj*yj+zj*zj
rrmij=1.0D0/rij
rij=dsqrt(rij)
! peptide-group centers and side chains and its gradient in virtual-bond and
! side-chain vectors.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
xi=0.5D0*(c(1,i)+c(1,i+1))
yi=0.5D0*(c(2,i)+c(2,i+1))
zi=0.5D0*(c(3,i)+c(3,i+1))
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
+ call to_box(xi,yi,zi)
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
xj=c(1,j)
yj=c(2,j)
zj=c(3,j)
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(1.0d0/rrij)
! peptide-group centers and side chains and its gradient in virtual-bond and
! side-chain vectors.
!
-! implicit real*8 (a-h,o-z)
+! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! include 'COMMON.VAR'
xi=0.5D0*(c(1,i)+c(1,i+1))
yi=0.5D0*(c(2,i)+c(2,i+1))
zi=0.5D0*(c(3,i)+c(3,i+1))
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
+ call to_box(xi,yi,zi)
+ if (zi.lt.0) zi=zi+boxzsize
do iint=1,nscp_gr(i)
xj=c(1,j)
yj=c(2,j)
zj=c(3,j)
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
-
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
rij=dsqrt(1.0d0/rrij)
sss_ele_cut=sscale_ele(rij)
! 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 short-range part of ESCp
!
if (ipot.lt.6) then
- call escp_short(evdw2,evdw2_14)
+ call escp_short(evdw2,evdw2_14)
endif
!
! Calculate the bond-stretching energy
!
! Calculate the disulfide-bridge and other energy and the contributions
! from other distance constraints.
- call edis(ehpb)
+! call edis(ehpb)
!
! Calculate the virtual-bond-angle energy.
!
!
if (wang.gt.0d0) then
if (tor_mode.eq.0) then
- call ebend(ebe)
+ call ebend(ebe)
else
!C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
!C energy function
- call ebend_kcc(ebe)
+ call ebend_kcc(ebe)
endif
else
- ebe=0.0d0
+ ebe=0.0d0
endif
ethetacnstr=0.0d0
if (with_theta_constr) call etheta_constr(ethetacnstr)
if (wtor.gt.0.0d0) then
if (tor_mode.eq.0) then
call etor(etors)
- else
+ else
!C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
!C energy function
- call etor_kcc(etors)
+ call etor_kcc(etors)
endif
else
- etors=0.0d0
+ etors=0.0d0
endif
edihcnstr=0.0d0
if (ndih_constr.gt.0) call etor_constr(edihcnstr)
call etor_d(etors_d)
endif
!
+! Homology restraints
+!
+ if (constr_homology.ge.1) then
+ call e_modeller(ehomology_constr)
+! print *,"tu"
+ else
+ ehomology_constr=0.0d0
+ endif
+
+!
! 21/5/07 Calculate local sicdechain correlation energy
!
if (wsccor.gt.0.0d0) then
- call eback_sc_corr(esccor)
+ call eback_sc_corr(esccor)
else
- esccor=0.0d0
+ esccor=0.0d0
endif
!
! Put energy components into an array
!
do i=1,n_ene
- energia(i)=0.0d0
+ energia(i)=0.0d0
enddo
energia(1)=evdw
#ifdef SCP14
energia(17)=estr
energia(19)=edihcnstr
energia(21)=esccor
+ energia(51)=ehomology_constr
! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
call flush(iout)
call sum_energy(energia,.true.)
if (y.lt.ymin) then
gnmr1=(ymin-y)**wykl/wykl
else if (y.gt.ymax) then
- gnmr1=(y-ymax)**wykl/wykl
+ gnmr1=(y-ymax)**wykl/wykl
else
- gnmr1=0.0d0
+ gnmr1=0.0d0
endif
return
end function gnmr1
real(kind=8) :: y,ymin,ymax
real(kind=8) :: wykl=4.0d0
if (y.lt.ymin) then
- gnmr1prim=-(ymin-y)**(wykl-1)
+ gnmr1prim=-(ymin-y)**(wykl-1)
else if (y.gt.ymax) then
- gnmr1prim=(y-ymax)**(wykl-1)
+ gnmr1prim=(y-ymax)**(wykl-1)
else
- gnmr1prim=0.0d0
+ gnmr1prim=0.0d0
endif
return
end function gnmr1prim
if (y.lt.ymin) then
rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
else if (y.gt.ymax) then
- rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
+ rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
else
rlornmr1=0.0d0
endif
rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
((ymin-y)**wykl+sigma**wykl)**2
else if (y.gt.ymax) then
- rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
+ rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
((y-ymax)**wykl+sigma**wykl)**2
else
- rlornmr1prim=0.0d0
+ rlornmr1prim=0.0d0
endif
return
end function rlornmr1prim
!-----------------------------------------------------------------------------
! 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'
gthetai=0.0D0
gphii=0.0D0
do j=i+1,nres-1
- ind=ind+1
+ ind=ind+1
! ind=indmat(i,j)
! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
- do k=1,3
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- enddo
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- enddo
+ do k=1,3
+ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
enddo
+ do k=1,3
+ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
+ enddo
+ enddo
do j=i+1,nres-1
- ind1=ind1+1
+ ind1=ind1+1
! ind1=indmat(i,j)
! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
do k=1,3
!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
! include 'COMMON.TIME1'
!
integer :: i,j
+ real(kind=8) :: time00,time01
! This subrouting calculates total Cartesian coordinate gradient.
! The subroutine chainbuild_cart and energy MUST be called beforehand.
!
!#define DEBUG
-#ifdef TIMING
+#ifdef TIMINGtime01
time00=MPI_Wtime()
#endif
icg=1
!#define DEBUG
!el write (iout,*) "After sum_gradient"
#ifdef DEBUG
-!el write (iout,*) "After sum_gradient"
+ write (iout,*) "After sum_gradient"
do i=1,nres-1
write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
enddo
#ifdef DEBUG
- write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
- (gxcart(j,i),j=1,3),gloc(i,icg)
+ write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),&
+ (gxcart(j,i),j=1,3),gloc(i,icg),(gloc_sc(j,i,icg),j=1,3)
#endif
enddo
#ifdef TIMING
write (iout,*) "gcart and gxcart after int_to_cart"
do i=0,nres-1
write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
- (gxcart(j,i),j=1,3)
+ (gxcart(j,i),j=1,3)
enddo
#endif
!#undef DEBUG
#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
+ time_cartgrad=time_cartgrad+MPI_Wtime()-time00
#endif
!#undef DEBUG
- return
- end subroutine cartgrad
+ 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)
+ subroutine zerograd
+ ! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.DERIV'
! include 'COMMON.CHAIN'
! include 'COMMON.SCCOR'
!
!el local variables
- integer :: i,j,intertyp,k
+ integer :: i,j,intertyp,k
! Initialize Cartesian-coordinate gradient
!
! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
! common /mpgrad/
! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
-
-
+
+
! gradc(j,i,icg)=0.0d0
! gradx(j,i,icg)=0.0d0
! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
!elwrite(iout,*) "icg",icg
- do i=-1,nres
- do j=1,3
- gvdwx(j,i)=0.0D0
- gradx_scp(j,i)=0.0D0
- gvdwc(j,i)=0.0D0
- gvdwc_scp(j,i)=0.0D0
- gvdwc_scpp(j,i)=0.0d0
- gelc(j,i)=0.0D0
- gelc_long(j,i)=0.0D0
- gradb(j,i)=0.0d0
- gradbx(j,i)=0.0d0
- gvdwpp(j,i)=0.0d0
- gel_loc(j,i)=0.0d0
- gel_loc_long(j,i)=0.0d0
- ghpbc(j,i)=0.0D0
- ghpbx(j,i)=0.0D0
- gcorr3_turn(j,i)=0.0d0
- gcorr4_turn(j,i)=0.0d0
- gradcorr(j,i)=0.0d0
- gradcorr_long(j,i)=0.0d0
- gradcorr5_long(j,i)=0.0d0
- gradcorr6_long(j,i)=0.0d0
- gcorr6_turn_long(j,i)=0.0d0
- gradcorr5(j,i)=0.0d0
- gradcorr6(j,i)=0.0d0
- gcorr6_turn(j,i)=0.0d0
- gsccorc(j,i)=0.0d0
- gsccorx(j,i)=0.0d0
- gradc(j,i,icg)=0.0d0
- gradx(j,i,icg)=0.0d0
- gscloc(j,i)=0.0d0
- gsclocx(j,i)=0.0d0
- gliptran(j,i)=0.0d0
- gliptranx(j,i)=0.0d0
- gliptranc(j,i)=0.0d0
- gshieldx(j,i)=0.0d0
- gshieldc(j,i)=0.0d0
- gshieldc_loc(j,i)=0.0d0
- gshieldx_ec(j,i)=0.0d0
- gshieldc_ec(j,i)=0.0d0
- gshieldc_loc_ec(j,i)=0.0d0
- gshieldx_t3(j,i)=0.0d0
- gshieldc_t3(j,i)=0.0d0
- gshieldc_loc_t3(j,i)=0.0d0
- gshieldx_t4(j,i)=0.0d0
- gshieldc_t4(j,i)=0.0d0
- gshieldc_loc_t4(j,i)=0.0d0
- gshieldx_ll(j,i)=0.0d0
- gshieldc_ll(j,i)=0.0d0
- gshieldc_loc_ll(j,i)=0.0d0
- gg_tube(j,i)=0.0d0
- gg_tube_sc(j,i)=0.0d0
- gradafm(j,i)=0.0d0
- gradb_nucl(j,i)=0.0d0
- gradbx_nucl(j,i)=0.0d0
- gvdwpp_nucl(j,i)=0.0d0
- gvdwpp(j,i)=0.0d0
- gelpp(j,i)=0.0d0
- gvdwpsb(j,i)=0.0d0
- gvdwpsb1(j,i)=0.0d0
- gvdwsbc(j,i)=0.0d0
- gvdwsbx(j,i)=0.0d0
- gelsbc(j,i)=0.0d0
- gradcorr_nucl(j,i)=0.0d0
- gradcorr3_nucl(j,i)=0.0d0
- gradxorr_nucl(j,i)=0.0d0
- gradxorr3_nucl(j,i)=0.0d0
- gelsbx(j,i)=0.0d0
- gsbloc(j,i)=0.0d0
- gsblocx(j,i)=0.0d0
- gradpepcat(j,i)=0.0d0
- gradpepcatx(j,i)=0.0d0
- gradcatcat(j,i)=0.0d0
- gvdwx_scbase(j,i)=0.0d0
- gvdwc_scbase(j,i)=0.0d0
- gvdwx_pepbase(j,i)=0.0d0
- gvdwc_pepbase(j,i)=0.0d0
- gvdwx_scpho(j,i)=0.0d0
- gvdwc_scpho(j,i)=0.0d0
- gvdwc_peppho(j,i)=0.0d0
- enddo
- enddo
- do i=0,nres
- do j=1,3
- do intertyp=1,3
- gloc_sc(intertyp,i,icg)=0.0d0
- enddo
- enddo
+ do i=-1,nres
+ do j=1,3
+ gvdwx(j,i)=0.0D0
+ gradx_scp(j,i)=0.0D0
+ gvdwc(j,i)=0.0D0
+ gvdwc_scp(j,i)=0.0D0
+ gvdwc_scpp(j,i)=0.0d0
+ gelc(j,i)=0.0D0
+ gelc_long(j,i)=0.0D0
+ gradb(j,i)=0.0d0
+ gradbx(j,i)=0.0d0
+ gvdwpp(j,i)=0.0d0
+ gel_loc(j,i)=0.0d0
+ gel_loc_long(j,i)=0.0d0
+ ghpbc(j,i)=0.0D0
+ ghpbx(j,i)=0.0D0
+ gcorr3_turn(j,i)=0.0d0
+ gcorr4_turn(j,i)=0.0d0
+ gradcorr(j,i)=0.0d0
+ gradcorr_long(j,i)=0.0d0
+ gradcorr5_long(j,i)=0.0d0
+ gradcorr6_long(j,i)=0.0d0
+ gcorr6_turn_long(j,i)=0.0d0
+ gradcorr5(j,i)=0.0d0
+ gradcorr6(j,i)=0.0d0
+ gcorr6_turn(j,i)=0.0d0
+ gsccorc(j,i)=0.0d0
+ gsccorx(j,i)=0.0d0
+ gradc(j,i,icg)=0.0d0
+ gradx(j,i,icg)=0.0d0
+ gscloc(j,i)=0.0d0
+ gsclocx(j,i)=0.0d0
+ gliptran(j,i)=0.0d0
+ gliptranx(j,i)=0.0d0
+ gliptranc(j,i)=0.0d0
+ gshieldx(j,i)=0.0d0
+ gshieldc(j,i)=0.0d0
+ gshieldc_loc(j,i)=0.0d0
+ gshieldx_ec(j,i)=0.0d0
+ gshieldc_ec(j,i)=0.0d0
+ gshieldc_loc_ec(j,i)=0.0d0
+ gshieldx_t3(j,i)=0.0d0
+ gshieldc_t3(j,i)=0.0d0
+ gshieldc_loc_t3(j,i)=0.0d0
+ gshieldx_t4(j,i)=0.0d0
+ gshieldc_t4(j,i)=0.0d0
+ gshieldc_loc_t4(j,i)=0.0d0
+ gshieldx_ll(j,i)=0.0d0
+ gshieldc_ll(j,i)=0.0d0
+ gshieldc_loc_ll(j,i)=0.0d0
+ gg_tube(j,i)=0.0d0
+ gg_tube_sc(j,i)=0.0d0
+ gradafm(j,i)=0.0d0
+ gradb_nucl(j,i)=0.0d0
+ gradbx_nucl(j,i)=0.0d0
+ gvdwpp_nucl(j,i)=0.0d0
+ gvdwpp(j,i)=0.0d0
+ gelpp(j,i)=0.0d0
+ gvdwpsb(j,i)=0.0d0
+ gvdwpsb1(j,i)=0.0d0
+ gvdwsbc(j,i)=0.0d0
+ gvdwsbx(j,i)=0.0d0
+ gelsbc(j,i)=0.0d0
+ gradcorr_nucl(j,i)=0.0d0
+ gradcorr3_nucl(j,i)=0.0d0
+ gradxorr_nucl(j,i)=0.0d0
+ gradxorr3_nucl(j,i)=0.0d0
+ gelsbx(j,i)=0.0d0
+ gsbloc(j,i)=0.0d0
+ gsblocx(j,i)=0.0d0
+ gradpepcat(j,i)=0.0d0
+ gradpepcatx(j,i)=0.0d0
+ gradcatcat(j,i)=0.0d0
+ gvdwx_scbase(j,i)=0.0d0
+ gvdwc_scbase(j,i)=0.0d0
+ gvdwx_pepbase(j,i)=0.0d0
+ gvdwc_pepbase(j,i)=0.0d0
+ gvdwx_scpho(j,i)=0.0d0
+ gvdwc_scpho(j,i)=0.0d0
+ gvdwc_peppho(j,i)=0.0d0
+ gradnuclcatx(j,i)=0.0d0
+ gradnuclcat(j,i)=0.0d0
+ gradlipbond(j,i)=0.0d0
+ gradlipang(j,i)=0.0d0
+ gradliplj(j,i)=0.0d0
+ gradlipelec(j,i)=0.0d0
+ gradcattranc(j,i)=0.0d0
+ gradcattranx(j,i)=0.0d0
+ gradcatangx(j,i)=0.0d0
+ gradcatangc(j,i)=0.0d0
+ gradpepmart(j,i)=0.0d0
+ gradpepmartx(j,i)=0.0d0
+ duscdiff(j,i)=0.0d0
+ duscdiffx(j,i)=0.0d0
+ enddo
+ enddo
+ do i=0,nres
+ do j=1,3
+ do intertyp=1,3
+ gloc_sc(intertyp,i,icg)=0.0d0
enddo
- do i=1,nres
- do j=1,maxcontsshi
- shield_list(j,i)=0
- do k=1,3
+ enddo
+ enddo
+ do i=1,nres
+ do j=1,maxcontsshi
+ shield_list(j,i)=0
+ do k=1,3
!C print *,i,j,k
- grad_shield_side(k,j,i)=0.0d0
- grad_shield_loc(k,j,i)=0.0d0
- enddo
- enddo
- ishield_list(i)=0
- enddo
+ grad_shield_side(k,j,i)=0.0d0
+ grad_shield_loc(k,j,i)=0.0d0
+ enddo
+ enddo
+ ishield_list(i)=0
+ enddo
!
! Initialize the gradient of local energy terms.
! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
! allocate(gsccor_loc(nres)) !(maxres)
- do i=1,4*nres
- gloc(i,icg)=0.0D0
- enddo
- do i=1,nres
- gel_loc_loc(i)=0.0d0
- gcorr_loc(i)=0.0d0
- g_corr5_loc(i)=0.0d0
- g_corr6_loc(i)=0.0d0
- gel_loc_turn3(i)=0.0d0
- gel_loc_turn4(i)=0.0d0
- gel_loc_turn6(i)=0.0d0
- gsccor_loc(i)=0.0d0
- enddo
+ do i=1,4*nres
+ gloc(i,icg)=0.0D0
+ enddo
+ do i=1,nres
+ gel_loc_loc(i)=0.0d0
+ gcorr_loc(i)=0.0d0
+ g_corr5_loc(i)=0.0d0
+ g_corr6_loc(i)=0.0d0
+ gel_loc_turn3(i)=0.0d0
+ gel_loc_turn4(i)=0.0d0
+ gel_loc_turn6(i)=0.0d0
+ gsccor_loc(i)=0.0d0
+ enddo
! initialize gcart and gxcart
! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
- do i=0,nres
- do j=1,3
- gcart(j,i)=0.0d0
- gxcart(j,i)=0.0d0
- enddo
- enddo
- return
- end subroutine zerograd
+ do i=0,nres
+ do j=1,3
+ gcart(j,i)=0.0d0
+ gxcart(j,i)=0.0d0
+ enddo
+ enddo
+ return
+ end subroutine zerograd
!-----------------------------------------------------------------------------
- real(kind=8) function fdum()
- fdum=0.0D0
- return
- end function fdum
+ real(kind=8) function fdum()
+ fdum=0.0D0
+ return
+ end function fdum
!-----------------------------------------------------------------------------
! intcartderiv.F
!-----------------------------------------------------------------------------
- subroutine intcartderiv
- ! implicit real*8 (a-h,o-z)
+ subroutine intcartderiv
+ ! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
- include 'mpif.h'
+ include 'mpif.h'
#endif
! include 'COMMON.SETUP'
! include 'COMMON.CHAIN'
! include 'COMMON.IOUNITS'
! include 'COMMON.LOCAL'
! include 'COMMON.SCCOR'
- real(kind=8) :: pi4,pi34
- real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
- real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
- dcosomega,dsinomega !(3,3,maxres)
- real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
-
- integer :: i,j,k
- real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
- fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
- fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
- fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
- integer :: nres2
- nres2=2*nres
+ real(kind=8) :: pi4,pi34
+ real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
+ real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
+ dcosomega,dsinomega !(3,3,maxres)
+ real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
+
+ integer :: i,j,k
+ real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
+ fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
+ fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
+ fac17,coso_inv,fac10,fac11,fac12,fac13,fac14,IERROR
+ integer :: nres2
+ nres2=2*nres
!el from module energy-------------
!el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
#if defined(MPI) && defined(PARINTDER)
- if (nfgtasks.gt.1 .and. me.eq.king) &
- call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
+ if (nfgtasks.gt.1 .and. me.eq.king) &
+ call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
#endif
- pi4 = 0.5d0*pipol
- pi34 = 3*pi4
+ pi4 = 0.5d0*pipol
+ pi34 = 3*pi4
! allocate(dtheta(3,2,nres)) !(3,2,maxres)
! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
- do i=1,nres
- do j=1,3
- dtheta(j,1,i)=0.0d0
- dtheta(j,2,i)=0.0d0
- dphi(j,1,i)=0.0d0
- dphi(j,2,i)=0.0d0
- dphi(j,3,i)=0.0d0
- enddo
- enddo
+ do i=1,nres
+ do j=1,3
+ dtheta(j,1,i)=0.0d0
+ dtheta(j,2,i)=0.0d0
+ dphi(j,1,i)=0.0d0
+ dphi(j,2,i)=0.0d0
+ dphi(j,3,i)=0.0d0
+ dcosomicron(j,1,1,i)=0.0d0
+ dcosomicron(j,1,2,i)=0.0d0
+ dcosomicron(j,2,1,i)=0.0d0
+ dcosomicron(j,2,2,i)=0.0d0
+ enddo
+ enddo
! Derivatives of theta's
#if defined(MPI) && defined(PARINTDER)
! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
- do i=max0(ithet_start-1,3),ithet_end
+ do i=max0(ithet_start-1,3),ithet_end
#else
- do i=3,nres
+ do i=3,nres
#endif
- cost=dcos(theta(i))
- sint=sqrt(1-cost*cost)
- do j=1,3
- dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
- vbld(i-1)
- if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
- dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
- vbld(i)
- if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
- enddo
- enddo
+ cost=dcos(theta(i))
+ sint=sqrt(1-cost*cost)
+ do j=1,3
+ dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
+ vbld(i-1)
+ if (((itype(i-1,1).ne.ntyp1).and.(sint.ne.0.0d0))) &
+ dtheta(j,1,i)=-dcostheta(j,1,i)/sint
+ dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
+ vbld(i)
+ if ((itype(i-1,1).ne.ntyp1).and.(sint.ne.0.0d0))&
+ dtheta(j,2,i)=-dcostheta(j,2,i)/sint
+ enddo
+ enddo
#if defined(MPI) && defined(PARINTDER)
! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
- do i=max0(ithet_start-1,3),ithet_end
+ do i=max0(ithet_start-1,3),ithet_end
#else
- do i=3,nres
+ do i=3,nres
#endif
- if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
- cost1=dcos(omicron(1,i))
- sint1=sqrt(1-cost1*cost1)
- cost2=dcos(omicron(2,i))
- sint2=sqrt(1-cost2*cost2)
- do j=1,3
+ if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1).and.molnum(i).lt.4) then
+ cost1=dcos(omicron(1,i))
+ sint1=sqrt(1-cost1*cost1)
+ cost2=dcos(omicron(2,i))
+ sint2=sqrt(1-cost2*cost2)
+ do j=1,3
!C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
- dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
- cost1*dc_norm(j,i-2))/ &
- vbld(i-1)
- domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i)
- dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
- +cost1*(dc_norm(j,i-1+nres)))/ &
- vbld(i-1+nres)
- domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i)
+ dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
+ cost1*dc_norm(j,i-2))/ &
+ vbld(i-1)
+ domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i)
+ dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
+ +cost1*(dc_norm(j,i-1+nres)))/ &
+ vbld(i-1+nres)
+ domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i)
!C Calculate derivative over second omicron Sci-1,Cai-1 Cai
!C Looks messy but better than if in loop
- dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
- +cost2*dc_norm(j,i-1))/ &
- vbld(i)
- domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i)
- dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
- +cost2*(-dc_norm(j,i-1+nres)))/ &
- vbld(i-1+nres)
+ dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
+ +cost2*dc_norm(j,i-1))/ &
+ vbld(i)
+ domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i)
+ dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
+ +cost2*(-dc_norm(j,i-1+nres)))/ &
+ vbld(i-1+nres)
! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
- domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i)
- enddo
- endif
- enddo
+ domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i)
+ enddo
+ endif
+ enddo
!elwrite(iout,*) "after vbld write"
! Derivatives of phi:
! If phi is 0 or 180 degrees, then the formulas
! have to be derived by power series expansion of the
! conventional formulas around 0 and 180.
#ifdef PARINTDER
- do i=iphi1_start,iphi1_end
+ do i=iphi1_start,iphi1_end
#else
- do i=4,nres
+ do i=4,nres
#endif
! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
! the conventional case
- sint=dsin(theta(i))
- sint1=dsin(theta(i-1))
- sing=dsin(phi(i))
- cost=dcos(theta(i))
- cost1=dcos(theta(i-1))
- cosg=dcos(phi(i))
- scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
+ sint=dsin(theta(i))
+ sint1=dsin(theta(i-1))
+ sing=dsin(phi(i))
+ cost=dcos(theta(i))
+ cost1=dcos(theta(i-1))
+ cosg=dcos(phi(i))
+ scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
! Obtaining the gamma derivatives from sine derivative
- if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
- phi(i).gt.pi34.and.phi(i).le.pi.or. &
- phi(i).ge.-pi.and.phi(i).le.-pi34) then
- call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
- dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
- -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
- dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
- dsinphi(j,2,i)= &
- -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
- -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
- dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
- dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
- +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
+ if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
+ phi(i).gt.pi34.and.phi(i).le.pi.or. &
+ phi(i).ge.-pi.and.phi(i).le.-pi34) then
+ call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
+ do j=1,3
+ if (sint.ne.0.0d0) then
+ ctgt=cost/sint
+ else
+ ctgt=0.0d0
+ endif
+ if (sint1.ne.0.0d0) then
+ ctgt1=cost1/sint1
+ else
+ ctgt1=0.0d0
+ endif
+ cosg_inv=1.0d0/cosg
+! if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
+ dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
+ -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
+ dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
+ dsinphi(j,2,i)= &
+ -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
+ dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
+ +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
- endif
+ dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
+! endif
+! write(iout,*) "just after,close to pi",dphi(j,3,i),&
+! sing*(ctgt1*dtheta(j,2,i-1)),ctgt*dtheta(j,1,i), &
+! (fac0*vp2(j)+sing*dc_norm(j,i-2)),vbld_inv(i-1)
+
! Bug fixed 3/24/05 (AL)
- enddo
+ enddo
! Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
- dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
- dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
- dc_norm(j,i-3))/vbld(i-2)
- dphi(j,1,i)=-1.0/sing*dcosphi(j,1,i)
- dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
- dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
- dcostheta(j,1,i)
- dphi(j,2,i)=-1.0/sing*dcosphi(j,2,i)
- dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
- dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
- dc_norm(j,i-1))/vbld(i)
- dphi(j,3,i)=-1.0/sing*dcosphi(j,3,i)
+ else
+ do j=1,3
+! if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
+ dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
+ dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
+ dc_norm(j,i-3))/vbld(i-2)
+ dphi(j,1,i)=-1.0/sing*dcosphi(j,1,i)
+ dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
+ dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
+ dcostheta(j,1,i)
+ dphi(j,2,i)=-1.0/sing*dcosphi(j,2,i)
+ dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
+ dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
+ dc_norm(j,i-1))/vbld(i)
+ dphi(j,3,i)=-1.0/sing*dcosphi(j,3,i)
!#define DEBUG
#ifdef DEBUG
- write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i)
+ write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i)
#endif
!#undef DEBUG
- endif
- enddo
- endif
- enddo
+! endif
+ enddo
+ endif
+ enddo
!alculate derivative of Tauangle
#ifdef PARINTDER
- do i=itau_start,itau_end
+ do i=itau_start,itau_end
#else
- do i=3,nres
+ do i=3,nres
!elwrite(iout,*) " vecpr",i,nres
#endif
- if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
+ if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
!c dtauangle(j,intertyp,dervityp,residue number)
!c INTERTYP=1 SC...Ca...Ca..Ca
! the conventional case
- sint=dsin(theta(i))
- sint1=dsin(omicron(2,i-1))
- sing=dsin(tauangle(1,i))
- cost=dcos(theta(i))
- cost1=dcos(omicron(2,i-1))
- cosg=dcos(tauangle(1,i))
+ sint=dsin(theta(i))
+ sint1=dsin(omicron(2,i-1))
+ sing=dsin(tauangle(1,i))
+ cost=dcos(theta(i))
+ cost1=dcos(omicron(2,i-1))
+ cosg=dcos(tauangle(1,i))
!elwrite(iout,*) " vecpr5",i,nres
- do j=1,3
+ do j=1,3
!elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
!elwrite(iout,*) " vecpr5",dc_norm2(1,1)
- dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
+ dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
- enddo
- scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
- ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
+ enddo
+ scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
+ ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
+
! Obtaining the gamma derivatives from sine derivative
- if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
- tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
- tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
- call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
- -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
- *vbld_inv(i-2+nres)
- dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
- dsintau(j,1,2,i)= &
- -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
- -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
+ tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
+ tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
+ call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
+ do j=1,3
+ ctgt=cost/sint
+ ctgt1=cost1/sint1
+ cosg_inv=1.0d0/cosg
+ dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
+ -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
+ *vbld_inv(i-2+nres)
+ dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
+ dsintau(j,1,2,i)= &
+ -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
! write(iout,*) "dsintau", dsintau(j,1,2,i)
- dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
+ dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
! Bug fixed 3/24/05 (AL)
- dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
- +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
+ dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
+ +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
- enddo
+ dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
+ enddo
! Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
- dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
- (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
- dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
- dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
- dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
- dcostheta(j,1,i)
- dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
- dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
- dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
- dc_norm(j,i-1))/vbld(i)
- dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
+ else
+ do j=1,3
+ dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
+ dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
+ (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
+ dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
+ dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
+ dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
+ dcostheta(j,1,i)
+ dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
+ dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
+ dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
+ dc_norm(j,i-1))/vbld(i)
+ dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
! write (iout,*) "else",i
- enddo
- endif
+ enddo
+ endif
! do k=1,3
! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
! enddo
- enddo
+ enddo
!C Second case Ca...Ca...Ca...SC
#ifdef PARINTDER
- do i=itau_start,itau_end
+ do i=itau_start,itau_end
#else
- do i=4,nres
+ do i=4,nres
#endif
- if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
- (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
+ if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
+ (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
! the conventional case
- sint=dsin(omicron(1,i))
- sint1=dsin(theta(i-1))
- sing=dsin(tauangle(2,i))
- cost=dcos(omicron(1,i))
- cost1=dcos(theta(i-1))
- cosg=dcos(tauangle(2,i))
+ sint=dsin(omicron(1,i))
+ sint1=dsin(theta(i-1))
+ sing=dsin(tauangle(2,i))
+ cost=dcos(omicron(1,i))
+ cost1=dcos(theta(i-1))
+ cosg=dcos(tauangle(2,i))
! do j=1,3
! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
! enddo
- scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
+ scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
! Obtaining the gamma derivatives from sine derivative
- if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
- tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
- tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
- call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
- +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
+ if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
+ tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
+ tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
+ call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
+ do j=1,3
+ ctgt=cost/sint
+ ctgt1=cost1/sint1
+ cosg_inv=1.0d0/cosg
+ dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
+ +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
- dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
- dsintau(j,2,2,i)= &
- -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
- -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
+ dsintau(j,2,2,i)= &
+ -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
! & sing*ctgt*domicron(j,1,2,i),
! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
- dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
+ dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
! Bug fixed 3/24/05 (AL)
- dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
- +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
+ dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
+ +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
- enddo
+ dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
+ enddo
! Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
- dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
- dc_norm(j,i-3))/vbld(i-2)
- dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
- dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
- dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
- dcosomicron(j,1,1,i)
- dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
- dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
- dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
- dc_norm(j,i-1+nres))/vbld(i-1+nres)
- dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
+ else
+ do j=1,3
+ dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
+ dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
+ dc_norm(j,i-3))/vbld(i-2)
+ dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
+ dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
+ dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
+ dcosomicron(j,1,1,i)
+ dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
+ dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
+ dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
+ dc_norm(j,i-1+nres))/vbld(i-1+nres)
+ dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
- enddo
- endif
- enddo
+ enddo
+ endif
+ enddo
!CC third case SC...Ca...Ca...SC
#ifdef PARINTDER
- do i=itau_start,itau_end
+ do i=itau_start,itau_end
#else
- do i=3,nres
+ do i=3,nres
#endif
! the conventional case
- if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
- (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
- sint=dsin(omicron(1,i))
- sint1=dsin(omicron(2,i-1))
- sing=dsin(tauangle(3,i))
- cost=dcos(omicron(1,i))
- cost1=dcos(omicron(2,i-1))
- cosg=dcos(tauangle(3,i))
- do j=1,3
- dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
+ if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
+ (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
+ sint=dsin(omicron(1,i))
+ sint1=dsin(omicron(2,i-1))
+ sing=dsin(tauangle(3,i))
+ cost=dcos(omicron(1,i))
+ cost1=dcos(omicron(2,i-1))
+ cosg=dcos(tauangle(3,i))
+ do j=1,3
+ dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
- enddo
- scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
+ enddo
+ scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
+ if ((sint*sint1).eq.0.0d0) then
+ fac0=0.0d0
+ else
+ fac0=1.0d0/(sint1*sint)
+ endif
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ if (sint1.ne.0.0d0) then
+ fac3=cosg*cost1/(sint1*sint1)
+ else
+ fac3=0.0d0
+ endif
+ if (sint.ne.0.0d0) then
+ fac4=cosg*cost/(sint*sint)
+ else
+ fac4=0.0d0
+ endif
! Obtaining the gamma derivatives from sine derivative
- if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
- tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
- tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
- call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
- -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
- *vbld_inv(i-2+nres)
- dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
- dsintau(j,3,2,i)= &
- -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
- -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
- dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
+ if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
+ tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
+ tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
+ call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
+ call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
+ do j=1,3
+ ctgt=cost/sint
+ ctgt1=cost1/sint1
+ cosg_inv=1.0d0/cosg
+ dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
+ -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
+ *vbld_inv(i-2+nres)
+ dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
+ dsintau(j,3,2,i)= &
+ -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
! Bug fixed 3/24/05 (AL)
- dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
- +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
- *vbld_inv(i-1+nres)
+ dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
+ +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
+ *vbld_inv(i-1+nres)
! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
- enddo
+ dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
+ enddo
! Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
- dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
- dc_norm2(j,i-2+nres))/vbld(i-2+nres)
- dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
- dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
- dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
- dcosomicron(j,1,1,i)
- dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
- dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
- dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
- dc_norm(j,i-1+nres))/vbld(i-1+nres)
- dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
+ else
+ do j=1,3
+ dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
+ dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
+ dc_norm2(j,i-2+nres))/vbld(i-2+nres)
+ dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
+ dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
+ dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
+ dcosomicron(j,1,1,i)
+ dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
+ dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
+ dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
+ dc_norm(j,i-1+nres))/vbld(i-1+nres)
+ dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
! write(iout,*) "else",i
- enddo
- endif
- enddo
+ enddo
+ endif
+ enddo
#ifdef CRYST_SC
! Derivatives of side-chain angles alpha and omega
#if defined(MPI) && defined(PARINTDER)
- do i=ibond_start,ibond_end
+ do i=ibond_start,ibond_end
#else
- do i=2,nres-1
-#endif
- if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
- fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
- fac6=fac5/vbld(i)
- fac7=fac5*fac5
- fac8=fac5/vbld(i+1)
- fac9=fac5/vbld(i+nres)
- scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
- scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
- cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
- (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
- -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
- sina=sqrt(1-cosa*cosa)
- sino=dsin(omeg(i))
+ do i=2,nres-1
+#endif
+ if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
+ fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
+ fac6=fac5/vbld(i)
+ fac7=fac5*fac5
+ fac8=fac5/vbld(i+1)
+ fac9=fac5/vbld(i+nres)
+ scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
+ scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
+ cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
+ (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
+ -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
+ sina=sqrt(1-cosa*cosa)
+ sino=dsin(omeg(i))
! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
- do j=1,3
- dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
- dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
- dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
- dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
- scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
- dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
- dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
- dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
- vbld(i+nres))
- dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
- enddo
+ do j=1,3
+ dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
+ dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
+ dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
+ dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
+ scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
+ dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
+ dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
+ dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
+ vbld(i+nres))
+ dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
+ enddo
! obtaining the derivatives of omega from sines
- if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
- omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
- omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
- fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
- dsin(theta(i+1)))
- fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
- fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
- call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
- call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
- call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
- coso_inv=1.0d0/dcos(omeg(i))
- do j=1,3
- dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
- +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
- (sino*dc_norm(j,i-1))/vbld(i)
- domega(j,1,i)=coso_inv*dsinomega(j,1,i)
- dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
- +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
- -sino*dc_norm(j,i)/vbld(i+1)
- domega(j,2,i)=coso_inv*dsinomega(j,2,i)
- dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
- fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
- vbld(i+nres)
- domega(j,3,i)=coso_inv*dsinomega(j,3,i)
- enddo
- else
- ! obtaining the derivatives of omega from cosines
- fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
- fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
- fac12=fac10*sina
- fac13=fac12*fac12
- fac14=sina*sina
- do j=1,3
- dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
- dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
- (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
- fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
- domega(j,1,i)=-1/sino*dcosomega(j,1,i)
- dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
- dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
- dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
- (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
- dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
- domega(j,2,i)=-1/sino*dcosomega(j,2,i)
- dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
- scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
- (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
- domega(j,3,i)=-1/sino*dcosomega(j,3,i)
- enddo
- endif
- else
+ if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
+ omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
+ omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
+ fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
+ dsin(theta(i+1)))
+ fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
+ fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
+ call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
+ call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
+ call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
+ coso_inv=1.0d0/dcos(omeg(i))
do j=1,3
- do k=1,3
- dalpha(k,j,i)=0.0d0
- domega(k,j,i)=0.0d0
- enddo
- enddo
- endif
- enddo
+ dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
+ +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
+ (sino*dc_norm(j,i-1))/vbld(i)
+ domega(j,1,i)=coso_inv*dsinomega(j,1,i)
+ dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
+ +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
+ -sino*dc_norm(j,i)/vbld(i+1)
+ domega(j,2,i)=coso_inv*dsinomega(j,2,i)
+ dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
+ fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
+ vbld(i+nres)
+ domega(j,3,i)=coso_inv*dsinomega(j,3,i)
+ enddo
+ else
+ ! obtaining the derivatives of omega from cosines
+ fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
+ fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
+ fac12=fac10*sina
+ fac13=fac12*fac12
+ fac14=sina*sina
+ do j=1,3
+ dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
+ dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
+ (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
+ fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
+ domega(j,1,i)=-1/sino*dcosomega(j,1,i)
+ dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
+ dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
+ dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
+ (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
+ dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
+ domega(j,2,i)=-1/sino*dcosomega(j,2,i)
+ dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
+ scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
+ (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
+ domega(j,3,i)=-1/sino*dcosomega(j,3,i)
+ enddo
+ endif
+ else
+ do j=1,3
+ do k=1,3
+ dalpha(k,j,i)=0.0d0
+ domega(k,j,i)=0.0d0
+ enddo
+ enddo
+ endif
+ enddo
#endif
#if defined(MPI) && defined(PARINTDER)
- if (nfgtasks.gt.1) then
+ if (nfgtasks.gt.1) then
#ifdef DEBUG
!d write (iout,*) "Gather dtheta"
!d call flush(iout)
- write (iout,*) "dtheta before gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
- enddo
+ write (iout,*) "dtheta before gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
+ enddo
#endif
- call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
- MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
+ MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
+ king,FG_COMM,IERROR)
!#define DEBUG
#ifdef DEBUG
!d write (iout,*) "Gather dphi"
!d call flush(iout)
- write (iout,*) "dphi before gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
- enddo
+ write (iout,*) "dphi before gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
+ enddo
#endif
!#undef DEBUG
- call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
- MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
+ MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
+ king,FG_COMM,IERROR)
!d write (iout,*) "Gather dalpha"
!d call flush(iout)
#ifdef CRYST_SC
- call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
- MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
+ MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
+ king,FG_COMM,IERROR)
!d write (iout,*) "Gather domega"
!d call flush(iout)
- call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
- MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
+ MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
+ king,FG_COMM,IERROR)
#endif
- endif
+ endif
#endif
!#define DEBUG
#ifdef DEBUG
- write (iout,*) "dtheta after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
- enddo
- write (iout,*) "dphi after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
- enddo
- write (iout,*) "dalpha after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
- enddo
- write (iout,*) "domega after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
- enddo
+ write (iout,*) "dtheta after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
+ enddo
+ write (iout,*) "dphi after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
+ enddo
+ write (iout,*) "dalpha after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
+ enddo
+ write (iout,*) "domega after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
+ enddo
#endif
!#undef DEBUG
- return
- end subroutine intcartderiv
+ return
+ end subroutine intcartderiv
!-----------------------------------------------------------------------------
- subroutine checkintcartgrad
- ! implicit real*8 (a-h,o-z)
+ subroutine checkintcartgrad
+ ! implicit real(kind=8) (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
- include 'mpif.h'
+ include 'mpif.h'
#endif
! include 'COMMON.CHAIN'
! include 'COMMON.VAR'
! include 'COMMON.DERIV'
! include 'COMMON.IOUNITS'
! include 'COMMON.SETUP'
- real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
- real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
- real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
- real(kind=8),dimension(3) :: dc_norm_s
- real(kind=8) :: aincr=1.0d-5
- integer :: i,j
- real(kind=8) :: dcji
- do i=1,nres
- phi_s(i)=phi(i)
- theta_s(i)=theta(i)
- alph_s(i)=alph(i)
- omeg_s(i)=omeg(i)
- enddo
+ real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
+ real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
+ real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
+ real(kind=8),dimension(3) :: dc_norm_s
+ real(kind=8) :: aincr=1.0d-5
+ integer :: i,j
+ real(kind=8) :: dcji
+ do i=1,nres
+ phi_s(i)=phi(i)
+ theta_s(i)=theta(i)
+ alph_s(i)=alph(i)
+ omeg_s(i)=omeg(i)
+ enddo
! Check theta gradient
- write (iout,*) &
- "Analytical (upper) and numerical (lower) gradient of theta"
- write (iout,*)
- do i=3,nres
- do j=1,3
- dcji=dc(j,i-2)
- dc(j,i-2)=dcji+aincr
- call chainbuild_cart
- call int_from_cart1(.false.)
- dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
- dc(j,i-2)=dcji
- dcji=dc(j,i-1)
- dc(j,i-1)=dc(j,i-1)+aincr
- call chainbuild_cart
- dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
- dc(j,i-1)=dcji
- enddo
+ write (iout,*) &
+ "Analytical (upper) and numerical (lower) gradient of theta"
+ write (iout,*)
+ do i=3,nres
+ do j=1,3
+ dcji=dc(j,i-2)
+ dc(j,i-2)=dcji+aincr
+ call chainbuild_cart
+ call int_from_cart1(.false.)
+ dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
+ dc(j,i-2)=dcji
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dc(j,i-1)+aincr
+ call chainbuild_cart
+ dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
+ dc(j,i-1)=dcji
+ enddo
!el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
!el (dtheta(j,2,i),j=1,3)
!el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
write (iout,*) &
"Analytical (upper) and numerical (lower) gradient of gamma"
do i=4,nres
- do j=1,3
- dcji=dc(j,i-3)
- dc(j,i-3)=dcji+aincr
- call chainbuild_cart
- dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-3)=dcji
- dcji=dc(j,i-2)
- dc(j,i-2)=dcji+aincr
- call chainbuild_cart
- dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-2)=dcji
- dcji=dc(j,i-1)
- dc(j,i-1)=dc(j,i-1)+aincr
- call chainbuild_cart
- dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-1)=dcji
- enddo
+ do j=1,3
+ dcji=dc(j,i-3)
+ dc(j,i-3)=dcji+aincr
+ call chainbuild_cart
+ dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-3)=dcji
+ dcji=dc(j,i-2)
+ dc(j,i-2)=dcji+aincr
+ call chainbuild_cart
+ dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-2)=dcji
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dc(j,i-1)+aincr
+ call chainbuild_cart
+ dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-1)=dcji
+ enddo
!el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
!el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
!el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
"Analytical (upper) and numerical (lower) gradient of alpha"
do i=2,nres-1
if(itype(i,1).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
- call chainbuild_cart
- dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i-1)=dcji
- dcji=dc(j,i)
- dc(j,i)=dcji+aincr
- call chainbuild_cart
- dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i)=dcji
- dcji=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call chainbuild_cart
- dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i+nres)=dcji
- enddo
- endif
+ do j=1,3
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dcji+aincr
+ call chainbuild_cart
+ dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i-1)=dcji
+ dcji=dc(j,i)
+ dc(j,i)=dcji+aincr
+ call chainbuild_cart
+ dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i)=dcji
+ dcji=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+aincr
+ call chainbuild_cart
+ dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i+nres)=dcji
+ enddo
+ endif
!el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
!el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
!el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
"Analytical (upper) and numerical (lower) gradient of omega"
do i=2,nres-1
if(itype(i,1).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
- call chainbuild_cart
- domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i-1)=dcji
- dcji=dc(j,i)
- dc(j,i)=dcji+aincr
- call chainbuild_cart
- domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i)=dcji
- dcji=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call chainbuild_cart
- domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i+nres)=dcji
- enddo
- endif
+ do j=1,3
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dcji+aincr
+ call chainbuild_cart
+ domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i-1)=dcji
+ dcji=dc(j,i)
+ dc(j,i)=dcji+aincr
+ call chainbuild_cart
+ domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i)=dcji
+ dcji=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+aincr
+ call chainbuild_cart
+ domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i+nres)=dcji
+ enddo
+ endif
!el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
!el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
!el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
! 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'
qq = 0.0d0
nl=0
if(flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
+ do il=seg1+nsep,seg2
+ do jl=seg1,il-nsep
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
- endif
- qq = qq+qqij+qqijCM
- enddo
- enddo
- qq = qq/nl
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
+ endif
+ qq = qq+qqij+qqijCM
+ enddo
+ enddo
+ qq = qq/nl
else
do il=seg1,seg2
- if((seg3-il).lt.3) then
- secseg=il+3
- else
- secseg=seg3
- endif
- do jl=secseg,seg4
+ if((seg3-il).lt.3) then
+ secseg=il+3
+ else
+ secseg=seg3
+ endif
+ do jl=secseg,seg4
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
- endif
- qq = qq+qqij+qqijCM
- enddo
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
+ endif
+ qq = qq+qqij+qqijCM
enddo
+ enddo
qq = qq/nl
endif
if (qqmax.le.qq) qqmax=qq
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'
!el sigm(x)=0.25d0*x ! local function
do kkk=1,nperm
do i=0,nres
- do j=1,3
- dqwol(j,i)=0.0d0
- dxqwol(j,i)=0.0d0
- enddo
+ do j=1,3
+ dqwol(j,i)=0.0d0
+ dxqwol(j,i)=0.0d0
+ enddo
enddo
nl=0
if(flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
+ do il=seg1+nsep,seg2
+ do jl=seg1,il-nsep
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ sim = 1.0d0/sigm(d0ij)
+ sim = sim*sim
+ dd0 = dij-d0ij
+ fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
+ do k=1,3
+ ddqij = (c(k,il)-c(k,jl))*fac
+ dqwol(k,il)=dqwol(k,il)+ddqij
+ dqwol(k,jl)=dqwol(k,jl)-ddqij
+ enddo
+
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- sim = 1.0d0/sigm(d0ij)
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ sim = 1.0d0/sigm(d0ijCM)
sim = sim*sim
- dd0 = dij-d0ij
- fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il)-c(k,jl))*fac
- dqwol(k,il)=dqwol(k,il)+ddqij
- dqwol(k,jl)=dqwol(k,jl)-ddqij
+ dd0=dijCM-d0ijCM
+ fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
+ do k=1,3
+ ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
+ dxqwol(k,il)=dxqwol(k,il)+ddqij
+ dxqwol(k,jl)=dxqwol(k,jl)-ddqij
enddo
-
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- sim = 1.0d0/sigm(d0ijCM)
- sim = sim*sim
- dd0=dijCM-d0ijCM
- fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
- dxqwol(k,il)=dxqwol(k,il)+ddqij
- dxqwol(k,jl)=dxqwol(k,jl)-ddqij
- enddo
- endif
- enddo
- enddo
+ endif
+ enddo
+ enddo
else
- do il=seg1,seg2
- if((seg3-il).lt.3) then
- secseg=il+3
- else
- secseg=seg3
- endif
- do jl=secseg,seg4
+ do il=seg1,seg2
+ if((seg3-il).lt.3) then
+ secseg=il+3
+ else
+ secseg=seg3
+ endif
+ do jl=secseg,seg4
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ sim = 1.0d0/sigm(d0ij)
+ sim = sim*sim
+ dd0 = dij-d0ij
+ fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
+ do k=1,3
+ ddqij = (c(k,il)-c(k,jl))*fac
+ dqwol(k,il)=dqwol(k,il)+ddqij
+ dqwol(k,jl)=dqwol(k,jl)-ddqij
+ enddo
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- sim = 1.0d0/sigm(d0ij)
- sim = sim*sim
- dd0 = dij-d0ij
- fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ sim = 1.0d0/sigm(d0ijCM)
+ sim=sim*sim
+ dd0 = dijCM-d0ijCM
+ fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
do k=1,3
- ddqij = (c(k,il)-c(k,jl))*fac
- dqwol(k,il)=dqwol(k,il)+ddqij
- dqwol(k,jl)=dqwol(k,jl)-ddqij
+ ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
+ dxqwol(k,il)=dxqwol(k,il)+ddqij
+ dxqwol(k,jl)=dxqwol(k,jl)-ddqij
enddo
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- sim = 1.0d0/sigm(d0ijCM)
- sim=sim*sim
- dd0 = dijCM-d0ijCM
- fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
- dxqwol(k,il)=dxqwol(k,il)+ddqij
- dxqwol(k,jl)=dxqwol(k,jl)-ddqij
- enddo
- endif
- enddo
- enddo
+ endif
+ enddo
+ enddo
endif
enddo
do i=0,nres
- do j=1,3
- dqwol(j,i)=dqwol(j,i)/nl
- dxqwol(j,i)=dxqwol(j,i)/nl
- enddo
+ do j=1,3
+ dqwol(j,i)=dqwol(j,i)/nl
+ dxqwol(j,i)=dxqwol(j,i)/nl
+ enddo
enddo
return
end subroutine qwolynes_prim
!-----------------------------------------------------------------------------
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'
integer :: i,j
do i=0,nres
- do j=1,3
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- cdummy(j,i)=c(j,i)
- c(j,i)=c(j,i)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolan(j,i)=(q2-q1)/delta
- c(j,i)=cdummy(j,i)
- enddo
+ do j=1,3
+ q1=qwolynes(seg1,seg2,flag,seg3,seg4)
+ cdummy(j,i)=c(j,i)
+ c(j,i)=c(j,i)+delta
+ q2=qwolynes(seg1,seg2,flag,seg3,seg4)
+ qwolan(j,i)=(q2-q1)/delta
+ c(j,i)=cdummy(j,i)
+ enddo
enddo
do i=0,nres
- do j=1,3
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- cdummy(j,i+nres)=c(j,i+nres)
- c(j,i+nres)=c(j,i+nres)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolxan(j,i)=(q2-q1)/delta
- c(j,i+nres)=cdummy(j,i+nres)
- enddo
+ do j=1,3
+ q1=qwolynes(seg1,seg2,flag,seg3,seg4)
+ cdummy(j,i+nres)=c(j,i+nres)
+ c(j,i+nres)=c(j,i+nres)+delta
+ q2=qwolynes(seg1,seg2,flag,seg3,seg4)
+ qwolxan(j,i)=(q2-q1)/delta
+ c(j,i+nres)=cdummy(j,i+nres)
+ enddo
enddo
! write(iout,*) "Numerical Q carteisan gradients backbone: "
! do i=0,nct
!-----------------------------------------------------------------------------
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'
! include 'COMMON.TIME1'
real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
- duconst,duxconst
+ duconst,duxconst
integer :: kstart,kend,lstart,lend,idummy
real(kind=8) :: delta=1.0d-7
integer :: i,j,k,ii
do i=0,nres
- do j=1,3
- duconst(j,i)=0.0d0
- dudconst(j,i)=0.0d0
- duxconst(j,i)=0.0d0
- dudxconst(j,i)=0.0d0
- enddo
+ do j=1,3
+ duconst(j,i)=0.0d0
+ dudconst(j,i)=0.0d0
+ duxconst(j,i)=0.0d0
+ dudxconst(j,i)=0.0d0
+ enddo
enddo
Uconst=0.0d0
do i=1,nfrag
- qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
- idummy,idummy)
- Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
+ qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
+ idummy,idummy)
+ Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
! Calculating the derivatives of Constraint energy with respect to Q
- Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
- qinfrag(i,iset))
+ Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
+ qinfrag(i,iset))
! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
! hmnum=(hm2-hm1)/delta
! & qinfrag(i,iset))
! write(iout,*) "harmonicnum frag", hmnum
! Calculating the derivatives of Q with respect to cartesian coordinates
- call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
- idummy,idummy)
+ call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
+ idummy,idummy)
! write(iout,*) "dqwol "
! do ii=1,nres
! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
! & ,idummy,idummy)
! The gradients of Uconst in Cs
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
- enddo
- enddo
+ do ii=0,nres
+ do j=1,3
+ duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
+ dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
+ enddo
+ enddo
enddo
do i=1,npair
- kstart=ifrag(1,ipair(1,i,iset),iset)
- kend=ifrag(2,ipair(1,i,iset),iset)
- lstart=ifrag(1,ipair(2,i,iset),iset)
- lend=ifrag(2,ipair(2,i,iset),iset)
- qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
- Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
+ kstart=ifrag(1,ipair(1,i,iset),iset)
+ kend=ifrag(2,ipair(1,i,iset),iset)
+ lstart=ifrag(1,ipair(2,i,iset),iset)
+ lend=ifrag(2,ipair(2,i,iset),iset)
+ qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
+ Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
! Calculating dU/dQ
- Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
+ Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
! hm1=harmonic(qpair(i),qinpair(i,iset))
! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
! hmnum=(hm2-hm1)/delta
! & qinpair(i,iset))
! write(iout,*) "harmonicnum pair ", hmnum
! Calculating dQ/dXi
- call qwolynes_prim(kstart,kend,.false.,&
- lstart,lend)
+ call qwolynes_prim(kstart,kend,.false.,&
+ lstart,lend)
! write(iout,*) "dqwol "
! do ii=1,nres
! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
! call qwol_num(kstart,kend,.false.
! & ,lstart,lend)
! The gradients of Uconst in Cs
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
- enddo
- enddo
+ do ii=0,nres
+ do j=1,3
+ duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
+ dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
+ enddo
+ enddo
enddo
! write(iout,*) "Uconst inside subroutine ", Uconst
! Transforming the gradients from Cs to dCs for the backbone
do i=0,nres
- do j=i+1,nres
- do k=1,3
- dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
- enddo
+ do j=i+1,nres
+ do k=1,3
+ dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
enddo
+ enddo
enddo
! Transforming the gradients from Cs to dCs for the side chains
do i=1,nres
- do j=1,3
- dudxconst(j,i)=duxconst(j,i)
- enddo
+ do j=1,3
+ dudxconst(j,i)=duxconst(j,i)
+ enddo
enddo
! write(iout,*) "dU/ddc backbone "
! do ii=0,nres
!-----------------------------------------------------------------------------
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'
! real(kind=8) ::
! For the backbone
do i=0,nres-1
- do j=1,3
- dUcartan(j,i)=0.0d0
- cdummy(j,i)=dc(j,i)
- dc(j,i)=dc(j,i)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- dc(j,i)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- ducartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
+ do j=1,3
+ dUcartan(j,i)=0.0d0
+ cdummy(j,i)=dc(j,i)
+ dc(j,i)=dc(j,i)+delta
+ call chainbuild_cart
+ uzap2=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ dc(j,i)=cdummy(j,i)
+ call chainbuild_cart
+ uzap1=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ ducartan(j,i)=(uzap2-uzap1)/(delta)
+ enddo
enddo
! Calculating numerical gradients for dU/ddx
do i=0,nres-1
- duxcartan(j,i)=0.0d0
- do j=1,3
- cdummy(j,i)=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- dc(j,i+nres)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
- ifrag(2,ii,iset),.true.,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- duxcartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
+ duxcartan(j,i)=0.0d0
+ do j=1,3
+ cdummy(j,i)=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+delta
+ call chainbuild_cart
+ uzap2=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ dc(j,i+nres)=cdummy(j,i)
+ call chainbuild_cart
+ uzap1=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
+ ifrag(2,ii,iset),.true.,idummy,idummy)
+ uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ duxcartan(j,i)=(uzap2-uzap1)/(delta)
+ enddo
enddo
write(iout,*) "Numerical dUconst/ddc backbone "
do ii=0,nres
- write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
+ write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
enddo
! write(iout,*) "Numerical dUconst/ddx side-chain "
! do ii=1,nres
!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
pmax=1
do k=1,3
- c(k,i)=0.0D0
- c(k,j)=0.0D0
- c(k,nres+i)=0.0D0
- c(k,nres+j)=0.0D0
+ c(k,i)=0.0D0
+ c(k,j)=0.0D0
+ c(k,nres+i)=0.0D0
+ c(k,nres+j)=0.0D0
enddo
do l=1,lmax
! pj=ran_number(0.0D0,pi/6.0D0)
! pj=0.0D0
- do p=1,pmax
+ do p=1,pmax
!t rij=ran_number(rmin,rmax)
- c(1,j)=d*sin(pj)*cos(tj)
- c(2,j)=d*sin(pj)*sin(tj)
- c(3,j)=d*cos(pj)
+ c(1,j)=d*sin(pj)*cos(tj)
+ c(2,j)=d*sin(pj)*sin(tj)
+ c(3,j)=d*cos(pj)
- c(3,nres+i)=-rij
+ c(3,nres+i)=-rij
- c(1,i)=d*sin(wi)
- c(3,i)=-rij-d*cos(wi)
+ c(1,i)=d*sin(wi)
+ c(3,i)=-rij-d*cos(wi)
- do k=1,3
- dc(k,nres+i)=c(k,nres+i)-c(k,i)
- dc_norm(k,nres+i)=dc(k,nres+i)/d
- dc(k,nres+j)=c(k,nres+j)-c(k,j)
- dc_norm(k,nres+j)=dc(k,nres+j)/d
- enddo
+ do k=1,3
+ dc(k,nres+i)=c(k,nres+i)-c(k,i)
+ dc_norm(k,nres+i)=dc(k,nres+i)/d
+ dc(k,nres+j)=c(k,nres+j)-c(k,j)
+ dc_norm(k,nres+j)=dc(k,nres+j)/d
+ enddo
- call dyn_ssbond_ene(i,j,eij)
- enddo
+ call dyn_ssbond_ene(i,j,eij,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
ssA=akcm
ssB=akct*deltat12
ssC=ss_depth &
- +akth*(deltat1*deltat1+deltat2*deltat2) &
- +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
+ +akth*(deltat1*deltat1+deltat2*deltat2) &
+ +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
ssxm=ssXs-0.5D0*ssB/ssA
!-------TESTING CODE
!-------TESTING CODE
! Stop and plot energy and derivative as a function of distance
if (checkstop) then
- ssm=ssC-0.25D0*ssB*ssB/ssA
- ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
- if (ssm.lt.ljm .and. &
- dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
- nicheck=1000
- njcheck=1
- deps=0.5d-7
- else
- checkstop=.false.
- endif
+ ssm=ssC-0.25D0*ssB*ssB/ssA
+ ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
+ if (ssm.lt.ljm .and. &
+ dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
+ nicheck=1000
+ njcheck=1
+ deps=0.5d-7
+ else
+ checkstop=.false.
+ endif
endif
if (.not.checkstop) then
- nicheck=0
- njcheck=-1
+ nicheck=0
+ njcheck=-1
endif
do icheck=0,nicheck
do jcheck=-1,njcheck
if (checkstop) rij=(ssxm-1.0d0)+ &
- ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
+ ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
!-------END TESTING CODE
if (rij.gt.ljxm) then
- havebond=.false.
- ljd=rij-ljXs
- fac=(1.0D0/ljd)**expon
- e1=fac*fac*aa_aq(itypi,itypj)
- e2=fac*bb_aq(itypi,itypj)
- eij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=eij*eps3rt
- eps3der=eij*eps2rt
- eij=eij*eps2rt*eps3rt
-
- sigder=-sig/sigsq
- e1=e1*eps1*eps2rt**2*eps3rt**2
- ed=-expon*(e1+eij)/ljd
- sigder=ed*sigder
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
- -2.0D0*alf12*eps3der+sigder*sigsq_om12
+ havebond=.false.
+ ljd=rij-ljXs
+ fac=(1.0D0/ljd)**expon
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
+ eij=eps1*eps2rt*eps3rt*(e1+e2)
+ eps2der=eij*eps3rt
+ eps3der=eij*eps2rt
+ eij=eij*eps2rt*eps3rt
+
+ sigder=-sig/sigsq
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ ed=-expon*(e1+eij)/ljd
+ sigder=ed*sigder
+ eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
+ eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
+ eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12
else if (rij.lt.ssxm) then
- havebond=.true.
- ssd=rij-ssXs
- eij=ssA*ssd*ssd+ssB*ssd+ssC
-
- ed=2*akcm*ssd+akct*deltat12
- pom1=akct*ssd
- pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
- eom1=-2*akth*deltat1-pom1-om2*pom2
- eom2= 2*akth*deltat2+pom1-om1*pom2
- eom12=pom2
+ havebond=.true.
+ ssd=rij-ssXs
+ eij=ssA*ssd*ssd+ssB*ssd+ssC
+
+ ed=2*akcm*ssd+akct*deltat12
+ pom1=akct*ssd
+ pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
+ eom1=-2*akth*deltat1-pom1-om2*pom2
+ eom2= 2*akth*deltat2+pom1-om1*pom2
+ eom12=pom2
else
- omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
+ omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
- d_ssxm(1)=0.5D0*akct/ssA
- d_ssxm(2)=-d_ssxm(1)
- d_ssxm(3)=0.0D0
+ d_ssxm(1)=0.5D0*akct/ssA
+ d_ssxm(2)=-d_ssxm(1)
+ d_ssxm(3)=0.0D0
- d_ljxm(1)=sig0ij/sqrt(sigsq**3)
- d_ljxm(2)=d_ljxm(1)*sigsq_om2
- d_ljxm(3)=d_ljxm(1)*sigsq_om12
- d_ljxm(1)=d_ljxm(1)*sigsq_om1
+ d_ljxm(1)=sig0ij/sqrt(sigsq**3)
+ d_ljxm(2)=d_ljxm(1)*sigsq_om2
+ d_ljxm(3)=d_ljxm(1)*sigsq_om12
+ d_ljxm(1)=d_ljxm(1)*sigsq_om1
!-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
- xm=0.5d0*(ssxm+ljxm)
- do k=1,3
- d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
- enddo
- if (rij.lt.xm) then
- havebond=.true.
- ssm=ssC-0.25D0*ssB*ssB/ssA
- d_ssm(1)=0.5D0*akct*ssB/ssA
- d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
- d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
- d_ssm(3)=omega
- f1=(rij-xm)/(ssxm-xm)
- f2=(rij-ssxm)/(xm-ssxm)
- h1=h_base(f1,hd1)
- h2=h_base(f2,hd2)
- eij=ssm*h1+Ht*h2
- delta_inv=1.0d0/(xm-ssxm)
- deltasq_inv=delta_inv*delta_inv
- fac=ssm*hd1-Ht*hd2
- fac1=deltasq_inv*fac*(xm-rij)
- fac2=deltasq_inv*fac*(rij-ssxm)
- ed=delta_inv*(Ht*hd2-ssm*hd1)
- eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
- eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
- eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
- else
- havebond=.false.
- ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
- d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
- d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
- d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
- alf12/eps3rt)
- d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
- f1=(rij-ljxm)/(xm-ljxm)
- f2=(rij-xm)/(ljxm-xm)
- h1=h_base(f1,hd1)
- h2=h_base(f2,hd2)
- eij=Ht*h1+ljm*h2
- delta_inv=1.0d0/(ljxm-xm)
- deltasq_inv=delta_inv*delta_inv
- fac=Ht*hd1-ljm*hd2
- fac1=deltasq_inv*fac*(ljxm-rij)
- fac2=deltasq_inv*fac*(rij-xm)
- ed=delta_inv*(ljm*hd2-Ht*hd1)
- eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
- eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
- eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
- endif
+ xm=0.5d0*(ssxm+ljxm)
+ do k=1,3
+ d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
+ enddo
+ if (rij.lt.xm) then
+ havebond=.true.
+ ssm=ssC-0.25D0*ssB*ssB/ssA
+ d_ssm(1)=0.5D0*akct*ssB/ssA
+ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
+ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
+ d_ssm(3)=omega
+ f1=(rij-xm)/(ssxm-xm)
+ f2=(rij-ssxm)/(xm-ssxm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=ssm*h1+Ht*h2
+ delta_inv=1.0d0/(xm-ssxm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=ssm*hd1-Ht*hd2
+ fac1=deltasq_inv*fac*(xm-rij)
+ fac2=deltasq_inv*fac*(rij-ssxm)
+ ed=delta_inv*(Ht*hd2-ssm*hd1)
+ eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
+ eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
+ eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
+ else
+ havebond=.false.
+ ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
+ d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
+ d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
+ d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
+ alf12/eps3rt)
+ d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
+ f1=(rij-ljxm)/(xm-ljxm)
+ f2=(rij-xm)/(ljxm-xm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=Ht*h1+ljm*h2
+ delta_inv=1.0d0/(ljxm-xm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=Ht*hd1-ljm*hd2
+ fac1=deltasq_inv*fac*(ljxm-rij)
+ fac2=deltasq_inv*fac*(rij-xm)
+ ed=delta_inv*(ljm*hd2-Ht*hd1)
+ eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
+ eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
+ eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
+ endif
!-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
!-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
! endif
!#endif
!#endif
- dyn_ssbond_ij(i,j)=eij
- 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)')
!-------TESTING CODE
!el if (checkstop) then
- if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
- "CHECKSTOP",rij,eij,ed
- echeck(jcheck)=eij
+ if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
+ "CHECKSTOP",rij,eij,ed
+ echeck(jcheck)=eij
!el endif
enddo
if (checkstop) then
- write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
+ write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
endif
enddo
if (checkstop) then
- transgrad=.true.
- checkstop=.false.
+ transgrad=.true.
+ checkstop=.false.
endif
!-------END TESTING CODE
do k=1,3
- dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
- dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
+ dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
+ dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
enddo
do k=1,3
- gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
+ gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
enddo
do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k) &
- +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
- +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)=gvdwx(k,j)+gg(k) &
- +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwx(k,i)=gvdwx(k,i)-gg(k) &
+ +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwx(k,j)=gvdwx(k,j)+gg(k) &
+ +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
enddo
!grad do k=i,j-1
!grad do l=1,3
!grad enddo
do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
enddo
return
end subroutine dyn_ssbond_ene
!--------------------------------------------------------------------------
- subroutine triple_ssbond_ene(resi,resj,resk,eij)
+ subroutine triple_ssbond_ene(resi,resj,resk,eij)
! implicit none
! Includes
use calc_data
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
itypj=itype(j,1)
xj=c(1,nres+j)
yj=c(2,nres+j)
zj=c(3,nres+j)
-
+ call to_box(xj,yj,zj)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
xk=c(1,nres+k)
yk=c(2,nres+k)
zk=c(3,nres+k)
-
+ call to_box(xk,yk,zk)
dxk=dc_norm(1,nres+k)
dyk=dc_norm(2,nres+k)
dzk=dc_norm(3,nres+k)
!C derivative over rij
fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
-eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
- gg(1)=xij*fac/rij
- gg(2)=yij*fac/rij
- gg(3)=zij*fac/rij
+ gg(1)=xij*fac/rij
+ gg(2)=yij*fac/rij
+ gg(3)=zij*fac/rij
do m=1,3
- gvdwx(m,i)=gvdwx(m,i)-gg(m)
- gvdwx(m,j)=gvdwx(m,j)+gg(m)
+ gvdwx(m,i)=gvdwx(m,i)-gg(m)
+ gvdwx(m,j)=gvdwx(m,j)+gg(m)
enddo
do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
enddo
!C now derivative over rik
fac=-eij1**2/dtriss* &
(-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
-eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
- gg(1)=xik*fac/rik
- gg(2)=yik*fac/rik
- gg(3)=zik*fac/rik
+ gg(1)=xik*fac/rik
+ gg(2)=yik*fac/rik
+ gg(3)=zik*fac/rik
do m=1,3
- gvdwx(m,i)=gvdwx(m,i)-gg(m)
- gvdwx(m,k)=gvdwx(m,k)+gg(m)
+ gvdwx(m,i)=gvdwx(m,i)-gg(m)
+ gvdwx(m,k)=gvdwx(m,k)+gg(m)
enddo
do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,k)=gvdwc(l,k)+gg(l)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,k)=gvdwc(l,k)+gg(l)
enddo
!C now derivative over rjk
fac=-eij2**2/dtriss* &
(-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
- gg(1)=xjk*fac/rjk
- gg(2)=yjk*fac/rjk
- gg(3)=zjk*fac/rjk
+ gg(1)=xjk*fac/rjk
+ gg(2)=yjk*fac/rjk
+ gg(3)=zjk*fac/rjk
do m=1,3
- gvdwx(m,j)=gvdwx(m,j)-gg(m)
- gvdwx(m,k)=gvdwx(m,k)+gg(m)
+ gvdwx(m,j)=gvdwx(m,j)-gg(m)
+ gvdwx(m,k)=gvdwx(m,k)+gg(m)
enddo
do l=1,3
- gvdwc(l,j)=gvdwc(l,j)-gg(l)
- gvdwc(l,k)=gvdwc(l,k)+gg(l)
+ gvdwc(l,j)=gvdwc(l,j)-gg(l)
+ gvdwc(l,k)=gvdwc(l,k)+gg(l)
enddo
return
end subroutine triple_ssbond_ene
! 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
- allnss=allnss+1
- allflag(allnss)=0
- allihpb(allnss)=i
- alljhpb(allnss)=j
- endif
- enddo
+ do j=i+1,nres
+ if ((itype(i,1).eq.1).and.(itype(j,1).eq.1)) then
+ k=k+1
+ if (dyn_ssbond_ij(k).lt.1.0d300) then
+ allnss=allnss+1
+ allflag(allnss)=0
+ allihpb(allnss)=i
+ alljhpb(allnss)=j
+ aliass(allnss)=k
+ endif
+ endif
+ enddo
enddo
!mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
1 emin=1.0d300
do i=1,allnss
+ if (allflag(i).eq.0 .and. &
+ dyn_ssbond_ij(aliass(allnss)).lt.emin) then
+ emin=dyn_ssbond_ij(aliass(allnss))
+ imin=i
+ endif
+ enddo
+ if (emin.lt.1.0d300) then
+ allflag(imin)=1
+ do i=1,allnss
if (allflag(i).eq.0 .and. &
- dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
- emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
- imin=i
+ (allihpb(i).eq.allihpb(imin) .or. &
+ alljhpb(i).eq.allihpb(imin) .or. &
+ allihpb(i).eq.alljhpb(imin) .or. &
+ alljhpb(i).eq.alljhpb(imin))) then
+ allflag(i)=-1
endif
enddo
- if (emin.lt.1.0d300) then
- allflag(imin)=1
- do i=1,allnss
- if (allflag(i).eq.0 .and. &
- (allihpb(i).eq.allihpb(imin) .or. &
- alljhpb(i).eq.allihpb(imin) .or. &
- allihpb(i).eq.alljhpb(imin) .or. &
- alljhpb(i).eq.alljhpb(imin))) then
- allflag(i)=-1
- endif
- enddo
- goto 1
+ goto 1
endif
!mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
newnss=0
do i=1,allnss
- if (allflag(i).eq.1) then
- newnss=newnss+1
- newihpb(newnss)=allihpb(i)
- newjhpb(newnss)=alljhpb(i)
- endif
+ if (allflag(i).eq.1) then
+ newnss=newnss+1
+ newihpb(newnss)=allihpb(i)
+ newjhpb(newnss)=alljhpb(i)
+ endif
enddo
#ifdef MPI
if (nfgtasks.gt.1)then
- call MPI_Reduce(newnss,g_newnss,1,&
- MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Gather(newnss,1,MPI_INTEGER,&
- i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
- displ(0)=0
- do i=1,nfgtasks-1,1
- displ(i)=i_newnss(i-1)+displ(i-1)
- enddo
- call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
- g_newihpb,i_newnss,displ,MPI_INTEGER,&
- king,FG_COMM,IERR)
- call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
- g_newjhpb,i_newnss,displ,MPI_INTEGER,&
- king,FG_COMM,IERR)
- if(fg_rank.eq.0) then
+ call MPI_Reduce(newnss,g_newnss,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+ call MPI_Gather(newnss,1,MPI_INTEGER,&
+ i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_newnss(i-1)+displ(i-1)
+ enddo
+ call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
+ g_newihpb,i_newnss,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
+ g_newjhpb,i_newnss,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ if(fg_rank.eq.0) then
! print *,'g_newnss',g_newnss
! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
- newnss=g_newnss
- do i=1,newnss
- newihpb(i)=g_newihpb(i)
- newjhpb(i)=g_newjhpb(i)
- enddo
- endif
+ newnss=g_newnss
+ do i=1,newnss
+ newihpb(i)=g_newihpb(i)
+ newjhpb(i)=g_newjhpb(i)
+ enddo
+ endif
endif
#endif
!mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
! print *,newnss,nss,maxdim
do i=1,nss
- found=.false.
+ found=.false.
! print *,newnss
- do j=1,newnss
+ do j=1,newnss
!! print *,j
- if (idssb(i).eq.newihpb(j) .and. &
- jdssb(i).eq.newjhpb(j)) found=.true.
- enddo
-#ifndef CLUST
-#ifndef WHAM
+ if (idssb(i).eq.newihpb(j) .and. &
+ jdssb(i).eq.newjhpb(j)) found=.true.
+ enddo
+#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
! write(iout,*) "found",found,i,j
- if (.not.found.and.fg_rank.eq.0) &
- write(iout,'(a15,f12.2,f8.1,2i5)') &
- "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
-#endif
+ if (.not.found.and.fg_rank.eq.0) &
+ write(iout,'(a15,f12.2,f8.1,2i5)') &
+ "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
#endif
enddo
do i=1,newnss
- found=.false.
- do j=1,nss
+ found=.false.
+ do j=1,nss
! print *,i,j
- if (newihpb(i).eq.idssb(j) .and. &
- newjhpb(i).eq.jdssb(j)) found=.true.
- enddo
-#ifndef CLUST
-#ifndef WHAM
+ if (newihpb(i).eq.idssb(j) .and. &
+ newjhpb(i).eq.jdssb(j)) found=.true.
+ enddo
+#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
! write(iout,*) "found",found,i,j
- if (.not.found.and.fg_rank.eq.0) &
- write(iout,'(a15,f12.2,f8.1,2i5)') &
- "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
-#endif
+ if (.not.found.and.fg_rank.eq.0) &
+ write(iout,'(a15,f12.2,f8.1,2i5)') &
+ "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
#endif
enddo
-
+!#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
nss=newnss
do i=1,nss
- idssb(i)=newihpb(i)
- jdssb(i)=newjhpb(i)
+ idssb(i)=newihpb(i)
+ jdssb(i)=newjhpb(i)
enddo
+!#else
+! nss=0
+!#endif
return
end subroutine dyn_set_nss
! print *, "I am in eliptran"
do i=ilip_start,ilip_end
!C do i=1,1
- if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
- cycle
+ if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
+ cycle
- positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
- if (positi.le.0.0) positi=positi+boxzsize
+ positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
+ if (positi.le.0.0) positi=positi+boxzsize
!C print *,i
!C first for peptide groups
!c for each residue check if it is in lipid or lipid water border area
if ((positi.gt.bordlipbot) &
.and.(positi.lt.bordliptop)) then
!C the energy transfer exist
- if (positi.lt.buflipbot) then
+ if (positi.lt.buflipbot) then
!C what fraction I am in
- fracinbuf=1.0d0- &
- ((positi-bordlipbot)/lipbufthick)
+ fracinbuf=1.0d0- &
+ ((positi-bordlipbot)/lipbufthick)
!C lipbufthick is thickenes of lipid buffore
- sslip=sscalelip(fracinbuf)
- ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*pepliptran
- gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
- gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*pepliptran
+ gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
+ gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
!C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
!C print *,"doing sccale for lower part"
!C print *,i,sslip,fracinbuf,ssgradlip
- elseif (positi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
- sslip=sscalelip(fracinbuf)
- ssgradlip=sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*pepliptran
- gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
- gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
+ elseif (positi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*pepliptran
+ gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
+ gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
!C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
!C print *, "doing sscalefor top part"
!C print *,i,sslip,fracinbuf,ssgradlip
- else
- eliptran=eliptran+pepliptran
+ else
+ eliptran=eliptran+pepliptran
!C print *,"I am in true lipid"
- endif
+ endif
!C else
!C eliptran=elpitran+0.0 ! I am in water
endif
enddo
! here starts the side chain transfer
do i=ilip_start,ilip_end
- if (itype(i,1).eq.ntyp1) cycle
- positi=(mod(c(3,i+nres),boxzsize))
- if (positi.le.0) positi=positi+boxzsize
+ if (itype(i,1).eq.ntyp1) cycle
+ positi=(mod(c(3,i+nres),boxzsize))
+ if (positi.le.0) positi=positi+boxzsize
!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
!c for each residue check if it is in lipid or lipid water border area
!C respos=mod(c(3,i+nres),boxzsize)
if ((positi.gt.bordlipbot) &
.and.(positi.lt.bordliptop)) then
!C the energy transfer exist
- if (positi.lt.buflipbot) then
- fracinbuf=1.0d0- &
- ((positi-bordlipbot)/lipbufthick)
+ if (positi.lt.buflipbot) then
+ fracinbuf=1.0d0- &
+ ((positi-bordlipbot)/lipbufthick)
!C lipbufthick is thickenes of lipid buffore
- sslip=sscalelip(fracinbuf)
- ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*liptranene(itype(i,1))
- gliptranx(3,i)=gliptranx(3,i) &
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*liptranene(itype(i,1))
+ gliptranx(3,i)=gliptranx(3,i) &
+ssgradlip*liptranene(itype(i,1))
- gliptranc(3,i-1)= gliptranc(3,i-1) &
+ gliptranc(3,i-1)= gliptranc(3,i-1) &
+ssgradlip*liptranene(itype(i,1))
!C print *,"doing sccale for lower part"
- elseif (positi.gt.bufliptop) then
- fracinbuf=1.0d0- &
+ elseif (positi.gt.bufliptop) then
+ fracinbuf=1.0d0- &
((bordliptop-positi)/lipbufthick)
- sslip=sscalelip(fracinbuf)
- ssgradlip=sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*liptranene(itype(i,1))
- gliptranx(3,i)=gliptranx(3,i) &
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*liptranene(itype(i,1))
+ gliptranx(3,i)=gliptranx(3,i) &
+ssgradlip*liptranene(itype(i,1))
- gliptranc(3,i-1)= gliptranc(3,i-1) &
+ gliptranc(3,i-1)= gliptranc(3,i-1) &
+ssgradlip*liptranene(itype(i,1))
!C print *, "doing sscalefor top part",sslip,fracinbuf
- else
- eliptran=eliptran+liptranene(itype(i,1))
+ else
+ eliptran=eliptran+liptranene(itype(i,1))
!C print *,"I am in true lipid"
- endif
- endif ! if in lipid or buffor
+ endif
+ endif ! if in lipid or buffor
!C else
!C eliptran=elpitran+0.0 ! I am in water
- if (energy_dec) write(iout,*) i,"eliptran=",eliptran
+ if (energy_dec) write(iout,*) i,"eliptran=",eliptran
enddo
return
end subroutine Eliptransfer
integer :: i,j,iti
Etube=0.0d0
do i=itube_start,itube_end
- enetube(i)=0.0d0
- enetube(i+nres)=0.0d0
+ enetube(i)=0.0d0
+ enetube(i+nres)=0.0d0
enddo
!C first we calculate the distance from tube center
!C for UNRES
xmin=boxxsize
ymin=boxysize
! Find minimum distance in periodic box
- do j=-1,1
- vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
- vectube(2)=vectube(2)+boxysize*j
- xminact=abs(vectube(1)-tubecenter(1))
- yminact=abs(vectube(2)-tubecenter(2))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- enddo
+ do j=-1,1
+ vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+ xminact=abs(vectube(1)-tubecenter(1))
+ yminact=abs(vectube(2)-tubecenter(2))
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
vectube(1)=vectube(1)-tubecenter(1)
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*pep_aa_tube/rdiff6- &
- 6.0d0*pep_bb_tube)/rdiff6/rdiff
+ 6.0d0*pep_bb_tube)/rdiff6/rdiff
!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
!C &rdiff,fac
!C now direction of gg_tube vector
- do j=1,3
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
- gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
- enddo
- enddo
+ do j=1,3
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+ gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+ enddo
+ enddo
!C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
!C print *,gg_tube(1,0),"TU"
do i=itube_start,itube_end
!C Lets not jump over memory as we use many times iti
- iti=itype(i,1)
+ iti=itype(i,1)
!C lets ommit dummy atoms for now
- if ((iti.eq.ntyp1) &
+ if ((iti.eq.ntyp1) &
!C in UNRES uncomment the line below as GLY has no side-chain...
!C .or.(iti.eq.10)
- ) cycle
+ ) cycle
xmin=boxxsize
ymin=boxysize
- do j=-1,1
- vectube(1)=mod((c(1,i+nres)),boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=mod((c(2,i+nres)),boxysize)
- vectube(2)=vectube(2)+boxysize*j
-
- xminact=abs(vectube(1)-tubecenter(1))
- yminact=abs(vectube(2)-tubecenter(2))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- enddo
+ do j=-1,1
+ vectube(1)=mod((c(1,i+nres)),boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=mod((c(2,i+nres)),boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+
+ xminact=abs(vectube(1)-tubecenter(1))
+ yminact=abs(vectube(2)-tubecenter(2))
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
!C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
sc_bb_tube=sc_bb_tube_par(iti)
enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
- 6.0d0*sc_bb_tube/rdiff6/rdiff
+ 6.0d0*sc_bb_tube/rdiff6/rdiff
!C now direction of gg_tube vector
- do j=1,3
- gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
- enddo
- enddo
- do i=itube_start,itube_end
- Etube=Etube+enetube(i)+enetube(i+nres)
- enddo
+ do j=1,3
+ gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+ enddo
+ enddo
+ do i=itube_start,itube_end
+ Etube=Etube+enetube(i)+enetube(i+nres)
+ enddo
!C print *,"ETUBE", etube
- return
- end subroutine calctube
+ return
+ end subroutine calctube
!C TO DO 1) add to total energy
!C 2) add to gradient summation
!C 3) add reading parameters (AND of course oppening of PARAM file)
!C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
!C simple Kihara potential
subroutine calctube2(Etube)
- real(kind=8),dimension(3) :: vectube
+ real(kind=8),dimension(3) :: vectube
real(kind=8) :: Etube,xtemp,xminact,yminact,&
ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
sstube,ssgradtube,sc_aa_tube,sc_bb_tube
integer:: i,j,iti
Etube=0.0d0
do i=itube_start,itube_end
- enetube(i)=0.0d0
- enetube(i+nres)=0.0d0
+ enetube(i)=0.0d0
+ enetube(i+nres)=0.0d0
enddo
!C first we calculate the distance from tube center
!C first sugare-phosphate group for NARES this would be peptide group
!C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
xmin=boxxsize
ymin=boxysize
- do j=-1,1
- vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
- vectube(2)=vectube(2)+boxysize*j
-
- xminact=abs(vectube(1)-tubecenter(1))
- yminact=abs(vectube(2)-tubecenter(2))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- enddo
+ do j=-1,1
+ vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+
+ xminact=abs(vectube(1)-tubecenter(1))
+ yminact=abs(vectube(2)-tubecenter(2))
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
vectube(1)=vectube(1)-tubecenter(1)
!C and its 6 power
rdiff6=rdiff**6.0d0
!C THIS FRAGMENT MAKES TUBE FINITE
- positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
- if (positi.le.0) positi=positi+boxzsize
+ positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
+ if (positi.le.0) positi=positi+boxzsize
!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
!c for each residue check if it is in lipid or lipid water border area
!C respos=mod(c(3,i+nres),boxzsize)
!C print *,positi,bordtubebot,buftubebot,bordtubetop
if ((positi.gt.bordtubebot) &
- .and.(positi.lt.bordtubetop)) then
+ .and.(positi.lt.bordtubetop)) then
!C the energy transfer exist
- if (positi.lt.buftubebot) then
- fracinbuf=1.0d0- &
- ((positi-bordtubebot)/tubebufthick)
+ if (positi.lt.buftubebot) then
+ fracinbuf=1.0d0- &
+ ((positi-bordtubebot)/tubebufthick)
!C lipbufthick is thickenes of lipid buffore
- sstube=sscalelip(fracinbuf)
- ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
!C print *,ssgradtube, sstube,tubetranene(itype(i,1))
- enetube(i)=enetube(i)+sstube*tubetranenepep
+ enetube(i)=enetube(i)+sstube*tubetranenepep
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *,"doing sccale for lower part"
- elseif (positi.gt.buftubetop) then
- fracinbuf=1.0d0- &
- ((bordtubetop-positi)/tubebufthick)
- sstube=sscalelip(fracinbuf)
- ssgradtube=sscagradlip(fracinbuf)/tubebufthick
- enetube(i)=enetube(i)+sstube*tubetranenepep
+ elseif (positi.gt.buftubetop) then
+ fracinbuf=1.0d0- &
+ ((bordtubetop-positi)/tubebufthick)
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=sscagradlip(fracinbuf)/tubebufthick
+ enetube(i)=enetube(i)+sstube*tubetranenepep
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *, "doing sscalefor top part",sslip,fracinbuf
- else
- sstube=1.0d0
- ssgradtube=0.0d0
- enetube(i)=enetube(i)+sstube*tubetranenepep
+ else
+ sstube=1.0d0
+ ssgradtube=0.0d0
+ enetube(i)=enetube(i)+sstube*tubetranenepep
!C print *,"I am in true lipid"
- endif
- else
+ endif
+ else
!C sstube=0.0d0
!C ssgradtube=0.0d0
- cycle
- endif ! if in lipid or buffor
+ cycle
+ endif ! if in lipid or buffor
!C for vectorization reasons we will sumup at the end to avoid depenence of previous
enetube(i)=enetube(i)+sstube* &
- (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
+ (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
!C write(iout,*) "TU13",i,rdiff6,enetube(i)
!C print *,rdiff,rdiff6,pep_aa_tube
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*pep_aa_tube/rdiff6- &
- 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
+ 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
!C &rdiff,fac
!C now direction of gg_tube vector
do j=1,3
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
- gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
- enddo
- gg_tube(3,i)=gg_tube(3,i) &
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+ gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+ enddo
+ gg_tube(3,i)=gg_tube(3,i) &
+ssgradtube*enetube(i)/sstube/2.0d0
- gg_tube(3,i-1)= gg_tube(3,i-1) &
+ gg_tube(3,i-1)= gg_tube(3,i-1) &
+ssgradtube*enetube(i)/sstube/2.0d0
- enddo
+ enddo
!C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
!C print *,gg_tube(1,0),"TU"
- do i=itube_start,itube_end
+ do i=itube_start,itube_end
!C Lets not jump over memory as we use many times iti
- iti=itype(i,1)
+ iti=itype(i,1)
!C lets ommit dummy atoms for now
- if ((iti.eq.ntyp1) &
+ if ((iti.eq.ntyp1) &
!!C in UNRES uncomment the line below as GLY has no side-chain...
- .or.(iti.eq.10) &
- ) cycle
- vectube(1)=c(1,i+nres)
- vectube(1)=mod(vectube(1),boxxsize)
- if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
- vectube(2)=c(2,i+nres)
- vectube(2)=mod(vectube(2),boxysize)
- if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
+ .or.(iti.eq.10) &
+ ) cycle
+ vectube(1)=c(1,i+nres)
+ vectube(1)=mod(vectube(1),boxxsize)
+ if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
+ vectube(2)=c(2,i+nres)
+ vectube(2)=mod(vectube(2),boxysize)
+ if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
vectube(1)=vectube(1)-tubecenter(1)
vectube(2)=vectube(2)-tubecenter(2)
!C THIS FRAGMENT MAKES TUBE FINITE
- positi=(mod(c(3,i+nres),boxzsize))
- if (positi.le.0) positi=positi+boxzsize
+ positi=(mod(c(3,i+nres),boxzsize))
+ if (positi.le.0) positi=positi+boxzsize
!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
!c for each residue check if it is in lipid or lipid water border area
!C respos=mod(c(3,i+nres),boxzsize)
!C print *,positi,bordtubebot,buftubebot,bordtubetop
if ((positi.gt.bordtubebot) &
- .and.(positi.lt.bordtubetop)) then
+ .and.(positi.lt.bordtubetop)) then
!C the energy transfer exist
- if (positi.lt.buftubebot) then
- fracinbuf=1.0d0- &
- ((positi-bordtubebot)/tubebufthick)
+ if (positi.lt.buftubebot) then
+ fracinbuf=1.0d0- &
+ ((positi-bordtubebot)/tubebufthick)
!C lipbufthick is thickenes of lipid buffore
- sstube=sscalelip(fracinbuf)
- ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
!C print *,ssgradtube, sstube,tubetranene(itype(i,1))
- enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
+ enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *,"doing sccale for lower part"
- elseif (positi.gt.buftubetop) then
- fracinbuf=1.0d0- &
- ((bordtubetop-positi)/tubebufthick)
+ elseif (positi.gt.buftubetop) then
+ fracinbuf=1.0d0- &
+ ((bordtubetop-positi)/tubebufthick)
- sstube=sscalelip(fracinbuf)
- ssgradtube=sscagradlip(fracinbuf)/tubebufthick
- enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=sscagradlip(fracinbuf)/tubebufthick
+ enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *, "doing sscalefor top part",sslip,fracinbuf
- else
- sstube=1.0d0
- ssgradtube=0.0d0
- enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
+ else
+ sstube=1.0d0
+ ssgradtube=0.0d0
+ enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
!C print *,"I am in true lipid"
- endif
- else
+ endif
+ else
!C sstube=0.0d0
!C ssgradtube=0.0d0
- cycle
- endif ! if in lipid or buffor
+ cycle
+ endif ! if in lipid or buffor
!CEND OF FINITE FRAGMENT
!C as the tube is infinity we do not calculate the Z-vector use of Z
!C as chosen axis
sc_aa_tube=sc_aa_tube_par(iti)
sc_bb_tube=sc_bb_tube_par(iti)
enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
- *sstube+enetube(i+nres)
+ *sstube+enetube(i+nres)
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
- 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
+ 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
!C now direction of gg_tube vector
- do j=1,3
- gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
- enddo
- gg_tube_SC(3,i)=gg_tube_SC(3,i) &
+ do j=1,3
+ gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+ enddo
+ gg_tube_SC(3,i)=gg_tube_SC(3,i) &
+ssgradtube*enetube(i+nres)/sstube
- gg_tube(3,i-1)= gg_tube(3,i-1) &
+ gg_tube(3,i-1)= gg_tube(3,i-1) &
+ssgradtube*enetube(i+nres)/sstube
- enddo
- do i=itube_start,itube_end
- Etube=Etube+enetube(i)+enetube(i+nres)
- enddo
+ enddo
+ do i=itube_start,itube_end
+ Etube=Etube+enetube(i)+enetube(i+nres)
+ enddo
!C print *,"ETUBE", etube
- return
- end subroutine calctube2
+ return
+ end subroutine calctube2
!=====================================================================================================================================
subroutine calcnano(Etube)
- real(kind=8),dimension(3) :: vectube
+ 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
- enetube(i+nres)=0.0d0
+ enetube(i)=0.0d0
+ enetube(i+nres)=0.0d0
enddo
!C first we calculate the distance from tube center
!C first sugare-phosphate group for NARES this would be peptide group
!C 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
+! 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)
- xminact=dabs(vectube(1)-tubecenter(1))
- yminact=dabs(vectube(2)-tubecenter(2))
- zminact=dabs(vectube(3)-tubecenter(3))
-
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- if (zmin.gt.zminact) then
- zmin=zminact
- ztemp=vectube(3)
- endif
- enddo
- vectube(1)=xtemp
- vectube(2)=ytemp
- vectube(3)=ztemp
-
- vectube(1)=vectube(1)-tubecenter(1)
- vectube(2)=vectube(2)-tubecenter(2)
- vectube(3)=vectube(3)-tubecenter(3)
+ 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 pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*pep_aa_tube/rdiff6- &
- 6.0d0*pep_bb_tube)/rdiff6/rdiff
+ 6.0d0*pep_bb_tube)/rdiff6/rdiff
!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
!C &rdiff,fac
- if (acavtubpep.eq.0.0d0) then
+ if (acavtubpep.eq.0.0d0) then
!C go to 667
- enecavtube(i)=0.0
- faccav=0.0
- else
- denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
- enecavtube(i)= &
- (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
- /denominator
- enecavtube(i)=0.0
- faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
- *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
- +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
- /denominator**2.0d0
+ enecavtube(i)=0.0
+ faccav=0.0
+ else
+ denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
+ enecavtube(i)= &
+ (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
+ /denominator
+ enecavtube(i)=0.0
+ faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
+ *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
+ +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
+ /denominator**2.0d0
!C faccav=0.0
!C fac=fac+faccav
!C 667 continue
- endif
- if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
- do j=1,3
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
- gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
- enddo
- enddo
+ endif
+ if (energy_dec) write(iout,*),"ETUBE_PEP",i,rdiff,enetube(i),enecavtube(i)
+ do j=1,3
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+ gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+ enddo
+ enddo
do i=itube_start,itube_end
- enecavtube(i)=0.0d0
+ enecavtube(i)=0.0d0
!C Lets not jump over memory as we use many times iti
- iti=itype(i,1)
+ iti=itype(i,1)
!C lets ommit dummy atoms for now
- if ((iti.eq.ntyp1) &
+ if ((iti.eq.ntyp1) &
!C in UNRES uncomment the line below as GLY has no side-chain...
!C .or.(iti.eq.10)
- ) cycle
- xmin=boxxsize
- ymin=boxysize
- zmin=boxzsize
- do j=-1,1
- vectube(1)=dmod((c(1,i+nres)),boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=dmod((c(2,i+nres)),boxysize)
- vectube(2)=vectube(2)+boxysize*j
- vectube(3)=dmod((c(3,i+nres)),boxzsize)
- vectube(3)=vectube(3)+boxzsize*j
-
-
- xminact=dabs(vectube(1)-tubecenter(1))
- yminact=dabs(vectube(2)-tubecenter(2))
- zminact=dabs(vectube(3)-tubecenter(3))
-
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- if (zmin.gt.zminact) then
- zmin=zminact
- ztemp=vectube(3)
- endif
- enddo
- vectube(1)=xtemp
- vectube(2)=ytemp
- vectube(3)=ztemp
+ ) cycle
+ xi=c(1,i+nres)
+ yi=c(2,i+nres)
+ zi=c(3,i+nres)
+ call to_box(xi,yi,zi)
+ tubezcenter=totTafm*velNANOconst+tubecenter(3)
+
+ vectube(1)=boxshift(xi-tubecenter(1),boxxsize)
+ vectube(2)=boxshift(yi-tubecenter(2),boxysize)
+ vectube(3)=boxshift(zi-tubecenter(3),boxzsize)
+
-!C 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
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
- 6.0d0*sc_bb_tube/rdiff6/rdiff
+ 6.0d0*sc_bb_tube/rdiff6/rdiff
!C fac=0.0
!C now direction of gg_tube vector
!C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
- if (acavtub(iti).eq.0.0d0) then
+ if (acavtub(iti).eq.0.0d0) then
!C go to 667
- enecavtube(i+nres)=0.0d0
- faccav=0.0d0
- else
- denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
- enecavtube(i+nres)= &
- (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
- /denominator
+ enecavtube(i+nres)=0.0d0
+ faccav=0.0d0
+ else
+ denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
+ enecavtube(i+nres)= &
+ (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
+ /denominator
!C enecavtube(i)=0.0
- faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
- *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
- +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
- /denominator**2.0d0
+ faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
+ *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
+ +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
+ /denominator**2.0d0
!C faccav=0.0
- fac=fac+faccav
+ fac=fac+faccav
!C 667 continue
- endif
+ endif
!C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
!C & enecavtube(i),faccav
!C print *,"licz=",
!C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
!C print *,"finene=",enetube(i+nres)+enecavtube(i)
- do j=1,3
- gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
- enddo
- if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
- enddo
+ do j=1,3
+ gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+ enddo
+ if (energy_dec) write(iout,*),"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
- do i=itube_start,itube_end
- Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
- +enecavtube(i+nres)
+!-----------------------------------------------------------------------
+ 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
! print *,"end",i,"a"
! enddo
!C print *,"ETUBE", etube
- return
- end subroutine calcnano
+ return
+ end subroutine calcnano
!===============================================
!--------------------------------------------------------------------------------
subroutine set_shield_fac2
real(kind=8) :: div77_81=0.974996043d0, &
- div4_81=0.2222222222d0
+ div4_81=0.2222222222d0
real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
- scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
- short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
- sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
+ scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
+ short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
+ sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
!C the vector between center of side_chain and peptide group
real(kind=8),dimension(3) :: pep_side_long,side_calf, &
- pept_group,costhet_grad,cosphi_grad_long, &
- cosphi_grad_loc,pep_side_norm,side_calf_norm, &
- sh_frac_dist_grad,pep_side
- integer i,j,k
+ pept_group,costhet_grad,cosphi_grad_long, &
+ cosphi_grad_loc,pep_side_norm,side_calf_norm, &
+ sh_frac_dist_grad,pep_side
+ integer i,j,k
!C write(2,*) "ivec",ivec_start,ivec_end
do i=1,nres
- fac_shield(i)=0.0d0
- ishield_list(i)=0
- do j=1,3
- grad_shield(j,i)=0.0d0
- enddo
+ fac_shield(i)=0.0d0
+ ishield_list(i)=0
+ do j=1,3
+ grad_shield(j,i)=0.0d0
+ enddo
enddo
do i=ivec_start,ivec_end
!C do i=1,nres-1
dist_pept_group=sqrt(dist_pept_group)
dist_side_calf=sqrt(dist_side_calf)
do j=1,3
- pep_side_norm(j)=pep_side(j)/dist_pep_side
- side_calf_norm(j)=dist_side_calf
+ pep_side_norm(j)=pep_side(j)/dist_pep_side
+ side_calf_norm(j)=dist_side_calf
enddo
!C now sscale fraction
sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
! print *,buff_shield,"buff",sh_frac_dist
!C now sscale
- if (sh_frac_dist.le.0.0) cycle
+ if (sh_frac_dist.le.0.0) cycle
!C print *,ishield_list(i),i
!C If we reach here it means that this side chain reaches the shielding sphere
!C Lets add him to the list for gradient
- ishield_list(i)=ishield_list(i)+1
+ ishield_list(i)=ishield_list(i)+1
!C ishield_list is a list of non 0 side-chain that contribute to factor gradient
!C this list is essential otherwise problem would be O3
- shield_list(ishield_list(i),i)=k
+ shield_list(ishield_list(i),i)=k
!C Lets have the sscale value
- if (sh_frac_dist.gt.1.0) then
- scale_fac_dist=1.0d0
- do j=1,3
- sh_frac_dist_grad(j)=0.0d0
- enddo
- else
- scale_fac_dist=-sh_frac_dist*sh_frac_dist &
- *(2.0d0*sh_frac_dist-3.0d0)
- fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
- /dist_pep_side/buff_shield*0.5d0
- do j=1,3
- sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
+ if (sh_frac_dist.gt.1.0) then
+ scale_fac_dist=1.0d0
+ do j=1,3
+ sh_frac_dist_grad(j)=0.0d0
+ enddo
+ else
+ scale_fac_dist=-sh_frac_dist*sh_frac_dist &
+ *(2.0d0*sh_frac_dist-3.0d0)
+ fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
+ /dist_pep_side/buff_shield*0.5d0
+ do j=1,3
+ sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
!C sh_frac_dist_grad(j)=0.0d0
!C scale_fac_dist=1.0d0
!C print *,"jestem",scale_fac_dist,fac_help_scale,
!C & sh_frac_dist_grad(j)
- enddo
- endif
+ enddo
+ endif
!C this is what is now we have the distance scaling now volume...
short=short_r_sidechain(itype(k,1))
long=long_r_sidechain(itype(k,1))
!C & -short/dist_pep_side**2/costhet)
!C costhet_fac=0.0d0
do j=1,3
- costhet_grad(j)=costhet_fac*pep_side(j)
+ costhet_grad(j)=costhet_fac*pep_side(j)
enddo
!C remember for the final gradient multiply costhet_grad(j)
!C for side_chain by factor -2 !
!C cosphi=0.6
cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
- dist_pep_side**2)
+ dist_pep_side**2)
!C sinphi=0.8
do j=1,3
- cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
+ cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
*(long-short)/fac_alfa_sin*cosalfa/ &
((dist_pep_side*dist_side_calf))* &
((side_calf(j))-cosalfa* &
((pep_side(j)/dist_pep_side)*dist_side_calf))
!C cosphi_grad_long(j)=0.0d0
- cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
+ cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
*(long-short)/fac_alfa_sin*cosalfa &
/((dist_pep_side*dist_side_calf))* &
(pep_side(j)- &
enddo
!C print *,sinphi,sinthet
VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
- /VSolvSphere_div
+ /VSolvSphere_div
!C & *wshield
!C now the gradient...
do j=1,3
grad_shield(j,i)=grad_shield(j,i) &
!C gradient po skalowaniu
- +(sh_frac_dist_grad(j)*VofOverlap &
+ +(sh_frac_dist_grad(j)*VofOverlap &
!C gradient po costhet
- +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
- (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
- sinphi/sinthet*costhet*costhet_grad(j) &
- +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
- )*wshield
+ +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
+ (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
+ sinphi/sinthet*costhet*costhet_grad(j) &
+ +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
+ )*wshield
!C grad_shield_side is Cbeta sidechain gradient
grad_shield_side(j,ishield_list(i),i)=&
- (sh_frac_dist_grad(j)*-2.0d0&
- *VofOverlap&
- -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
+ (sh_frac_dist_grad(j)*-2.0d0&
+ *VofOverlap&
+ -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
- sinphi/sinthet*costhet*costhet_grad(j)&
- +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
- )*wshield
+ sinphi/sinthet*costhet*costhet_grad(j)&
+ +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
+ )*wshield
! print *, 1.0d0/(-dsqrt(1.0d0-sinphi*sinthet)),&
! sinphi/sinthet,&
! +sinthet/sinphi,"HERE"
grad_shield_loc(j,ishield_list(i),i)= &
- scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
+ scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
- sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
- ))&
- *wshield
+ sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
+ ))&
+ *wshield
! print *,grad_shield_loc(j,ishield_list(i),i)
enddo
VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
! 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
+ cbeg=0.0d0
+ cend=0.0d0
+ if (afmbeg.eq.-1) then
+ do i=1,nbegafmmat
+ do j=1,3
+ cbeg(j)=cbeg(j)+c(j,afmbegcentr(i))/nbegafmmat
+ enddo
+ enddo
+ else
+ do j=1,3
+ cbeg(j)=c(j,afmend)
+ enddo
+ endif
+ if (afmend.eq.-1) then
+ do i=1,nendafmmat
+ do j=1,3
+ cend(j)=cend(j)+c(j,afmendcentr(i))/nendafmmat
+ enddo
+ enddo
+ else
+ cend(j)=c(j,afmend)
+ endif
+
do i=1,3
- diffafm(i)=c(i,afmend)-c(i,afmbeg)
+ diffafm(i)=cend(i)-cbeg(i)
afmdist=afmdist+diffafm(i)**2
enddo
afmdist=dsqrt(afmdist)
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
character(len=80) :: controlcard
do i=1,dyn_nssHist
- call card_concat(controlcard,.true.)
- read(controlcard,*) &
- dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
+ call card_concat(controlcard,.true.)
+ read(controlcard,*) &
+ dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
enddo
return
!el
! get the position of the jth ijth fragment of the chain coordinate system
! in the fromto array.
- integer :: i,j
+ integer :: i,j
- indmat=((2*(nres-2)-i)*(i-1))/2+j-1
+ indmat=((2*(nres-2)-i)*(i-1))/2+j-1
return
end function indmat
!-----------------------------------------------------------------------------
real(kind=8) function sigm(x)
!el
real(kind=8) :: x
- sigm=0.25d0*x
+ sigm=0.25d0*x
return
end function sigm
!-----------------------------------------------------------------------------
integer :: i,j
if(nres.lt.100) then
- maxconts=10*nres
+ maxconts=10*nres
elseif(nres.lt.200) then
- maxconts=10*nres ! Max. number of contacts per residue
+ maxconts=10*nres ! Max. number of contacts per residue
else
- maxconts=10*nres ! (maxconts=maxres/4)
+ maxconts=10*nres ! (maxconts=maxres/4)
endif
- maxcont=12*nres ! Max. number of SC contacts
+ maxcont=100*nres ! Max. number of SC contacts
maxvar=6*nres ! Max. number of variables
!el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
! 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
! if (nss.gt.0) then
- allocate(idssb(maxdim),jdssb(maxdim))
+ allocate(idssb(maxdim),jdssb(maxdim))
! allocate(newihpb(nss),newjhpb(nss))
!(maxdim)
! endif
allocate(uygrad(3,3,2,nres))
allocate(uzgrad(3,3,2,nres))
!(3,3,2,maxres)
+ print *,"before all 300"
+! allocateion of lists JPRDLA
+ allocate(newcontlistppi(300*nres))
+ allocate(newcontlistscpi(350*nres))
+ allocate(newcontlisti(300*nres))
+ allocate(newcontlistppj(300*nres))
+ allocate(newcontlistscpj(350*nres))
+ allocate(newcontlistj(300*nres))
+ allocate(newcontlistmartpi(300*nres))
+ allocate(newcontlistmartpj(300*nres))
+ allocate(newcontlistmartsci(300*nres))
+ allocate(newcontlistmartscj(300*nres))
+
+ allocate(newcontlistcatsctrani(300*nres))
+ allocate(newcontlistcatsctranj(300*nres))
+ allocate(newcontlistcatptrani(300*nres))
+ allocate(newcontlistcatptranj(300*nres))
+ allocate(newcontlistcatscnormi(300*nres))
+ allocate(newcontlistcatscnormj(300*nres))
+ allocate(newcontlistcatpnormi(300*nres))
+ allocate(newcontlistcatpnormj(300*nres))
+ allocate(newcontlistcatcatnormi(900*nres))
+ allocate(newcontlistcatcatnormj(900*nres))
+
+ allocate(newcontlistcatscangi(300*nres))
+ allocate(newcontlistcatscangj(300*nres))
+ allocate(newcontlistcatscangfi(300*nres))
+ allocate(newcontlistcatscangfj(300*nres))
+ allocate(newcontlistcatscangfk(300*nres))
+ allocate(newcontlistcatscangti(300*nres))
+ allocate(newcontlistcatscangtj(300*nres))
+ allocate(newcontlistcatscangtk(300*nres))
+ allocate(newcontlistcatscangtl(300*nres))
+
return
end subroutine alloc_ener_arrays
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
+ if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
+ vbldp0_nucl,diff,AKP_nucl*diff*diff
+ estr_nucl=estr_nucl+diff*diff
! print *,estr_nucl
- do j=1,3
- gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
- enddo
+ do j=1,3
+ gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
+ enddo
!c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
enddo
estr_nucl=0.5d0*AKP_nucl*estr_nucl
do i=ibond_nucl_start,ibond_nucl_end
!C print *, "I am stuck",i
- iti=itype(i,2)
- if (iti.eq.ntyp1_molec(2)) cycle
- nbi=nbondterm_nucl(iti)
+ iti=itype(i,2)
+ if (iti.eq.ntyp1_molec(2)) cycle
+ nbi=nbondterm_nucl(iti)
!C print *,iti,nbi
- if (nbi.eq.1) then
- diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
+ if (nbi.eq.1) then
+ diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
- if (energy_dec) &
- write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
- AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
- estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
+ if (energy_dec) &
+ write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
+ AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
+ estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
! print *,estr_nucl
- do j=1,3
- gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
- enddo
- else
- do j=1,nbi
- diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
- ud(j)=aksc_nucl(j,iti)*diff
- u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
- enddo
- uprod=u(1)
- do j=2,nbi
- uprod=uprod*u(j)
- enddo
- usum=0.0d0
- usumsqder=0.0d0
- do j=1,nbi
- uprod1=1.0d0
- uprod2=1.0d0
- do k=1,nbi
- if (k.ne.j) then
- uprod1=uprod1*u(k)
- uprod2=uprod2*u(k)*u(k)
- endif
- enddo
- usum=usum+uprod1
- usumsqder=usumsqder+ud(j)*uprod2
- enddo
- estr_nucl=estr_nucl+uprod/usum
- do j=1,3
- gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
+ do j=1,3
+ gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
+ enddo
+ else
+ do j=1,nbi
+ diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
+ ud(j)=aksc_nucl(j,iti)*diff
+ u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
+ enddo
+ uprod=u(1)
+ do j=2,nbi
+ uprod=uprod*u(j)
+ enddo
+ usum=0.0d0
+ usumsqder=0.0d0
+ do j=1,nbi
+ uprod1=1.0d0
+ uprod2=1.0d0
+ do k=1,nbi
+ if (k.ne.j) then
+ uprod1=uprod1*u(k)
+ uprod2=uprod2*u(k)*u(k)
+ endif
enddo
- endif
+ usum=usum+uprod1
+ usumsqder=usumsqder+ud(j)*uprod2
+ enddo
+ estr_nucl=estr_nucl+uprod/usum
+ do j=1,3
+ gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
+ enddo
+ endif
enddo
!C print *,"I am about to leave ebond"
return
etheta_nucl=0.0D0
! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
do i=ithet_nucl_start,ithet_nucl_end
- if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
- (itype(i-2,2).eq.ntyp1_molec(2)).or. &
- (itype(i,2).eq.ntyp1_molec(2))) cycle
- dethetai=0.0d0
- dephii=0.0d0
- dephii1=0.0d0
- theti2=0.5d0*theta(i)
- ityp2=ithetyp_nucl(itype(i-1,2))
- do k=1,nntheterm_nucl
- coskt(k)=dcos(k*theti2)
- sinkt(k)=dsin(k*theti2)
- enddo
- if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
+ if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
+ (itype(i-2,2).eq.ntyp1_molec(2)).or. &
+ (itype(i,2).eq.ntyp1_molec(2))) cycle
+ dethetai=0.0d0
+ dephii=0.0d0
+ dephii1=0.0d0
+ theti2=0.5d0*theta(i)
+ ityp2=ithetyp_nucl(itype(i-1,2))
+ do k=1,nntheterm_nucl
+ coskt(k)=dcos(k*theti2)
+ sinkt(k)=dsin(k*theti2)
+ enddo
+ if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
#ifdef OSF
- phii=phi(i)
- if (phii.ne.phii) phii=150.0
+ phii=phi(i)
+ if (phii.ne.phii) phii=150.0
#else
- phii=phi(i)
+ phii=phi(i)
#endif
- ityp1=ithetyp_nucl(itype(i-2,2))
- do k=1,nsingle_nucl
- cosph1(k)=dcos(k*phii)
- sinph1(k)=dsin(k*phii)
- enddo
- else
- phii=0.0d0
- ityp1=nthetyp_nucl+1
- do k=1,nsingle_nucl
- cosph1(k)=0.0d0
- sinph1(k)=0.0d0
- enddo
- endif
+ ityp1=ithetyp_nucl(itype(i-2,2))
+ do k=1,nsingle_nucl
+ cosph1(k)=dcos(k*phii)
+ sinph1(k)=dsin(k*phii)
+ enddo
+ else
+ phii=0.0d0
+ ityp1=nthetyp_nucl+1
+ do k=1,nsingle_nucl
+ cosph1(k)=0.0d0
+ sinph1(k)=0.0d0
+ enddo
+ endif
- if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
+ if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
#ifdef OSF
- phii1=phi(i+1)
- if (phii1.ne.phii1) phii1=150.0
- phii1=pinorm(phii1)
+ phii1=phi(i+1)
+ if (phii1.ne.phii1) phii1=150.0
+ phii1=pinorm(phii1)
#else
- phii1=phi(i+1)
+ phii1=phi(i+1)
#endif
- ityp3=ithetyp_nucl(itype(i,2))
- do k=1,nsingle_nucl
- cosph2(k)=dcos(k*phii1)
- sinph2(k)=dsin(k*phii1)
- enddo
- else
- phii1=0.0d0
- ityp3=nthetyp_nucl+1
- do k=1,nsingle_nucl
- cosph2(k)=0.0d0
- sinph2(k)=0.0d0
- enddo
- endif
- ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
- do k=1,ndouble_nucl
- do l=1,k-1
- ccl=cosph1(l)*cosph2(k-l)
- ssl=sinph1(l)*sinph2(k-l)
- scl=sinph1(l)*cosph2(k-l)
- csl=cosph1(l)*sinph2(k-l)
- cosph1ph2(l,k)=ccl-ssl
- cosph1ph2(k,l)=ccl+ssl
- sinph1ph2(l,k)=scl+csl
- sinph1ph2(k,l)=scl-csl
- enddo
+ ityp3=ithetyp_nucl(itype(i,2))
+ do k=1,nsingle_nucl
+ cosph2(k)=dcos(k*phii1)
+ sinph2(k)=dsin(k*phii1)
enddo
- if (lprn) then
- write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
- " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
- write (iout,*) "coskt and sinkt",nntheterm_nucl
- do k=1,nntheterm_nucl
- write (iout,*) k,coskt(k),sinkt(k)
+ else
+ phii1=0.0d0
+ ityp3=nthetyp_nucl+1
+ do k=1,nsingle_nucl
+ cosph2(k)=0.0d0
+ sinph2(k)=0.0d0
enddo
- endif
- do k=1,ntheterm_nucl
- ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
- dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
- *coskt(k)
- if (lprn)&
- write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
- " ethetai",ethetai
+ endif
+ ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
+ do k=1,ndouble_nucl
+ do l=1,k-1
+ ccl=cosph1(l)*cosph2(k-l)
+ ssl=sinph1(l)*sinph2(k-l)
+ scl=sinph1(l)*cosph2(k-l)
+ csl=cosph1(l)*sinph2(k-l)
+ cosph1ph2(l,k)=ccl-ssl
+ cosph1ph2(k,l)=ccl+ssl
+ sinph1ph2(l,k)=scl+csl
+ sinph1ph2(k,l)=scl-csl
enddo
- if (lprn) then
- write (iout,*) "cosph and sinph"
+ enddo
+ if (lprn) then
+ write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
+ " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
+ write (iout,*) "coskt and sinkt",nntheterm_nucl
+ do k=1,nntheterm_nucl
+ write (iout,*) k,coskt(k),sinkt(k)
+ enddo
+ endif
+ do k=1,ntheterm_nucl
+ ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
+ dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
+ *coskt(k)
+ if (lprn)&
+ write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
+ " ethetai",ethetai
+ enddo
+ if (lprn) then
+ write (iout,*) "cosph and sinph"
+ do k=1,nsingle_nucl
+ write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
+ enddo
+ write (iout,*) "cosph1ph2 and sinph2ph2"
+ do k=2,ndouble_nucl
+ do l=1,k-1
+ write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
+ sinph1ph2(l,k),sinph1ph2(k,l)
+ enddo
+ enddo
+ write(iout,*) "ethetai",ethetai
+ endif
+ do m=1,ntheterm2_nucl
do k=1,nsingle_nucl
- write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
+ aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
+ +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
+ +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
+ +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
+ ethetai=ethetai+sinkt(m)*aux
+ dethetai=dethetai+0.5d0*m*aux*coskt(m)
+ dephii=dephii+k*sinkt(m)*(&
+ ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
+ bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
+ dephii1=dephii1+k*sinkt(m)*(&
+ eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
+ ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
+ if (lprn) &
+ write (iout,*) "m",m," k",k," bbthet",&
+ bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
+ ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
+ ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
+ eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
enddo
- write (iout,*) "cosph1ph2 and sinph2ph2"
+ enddo
+ if (lprn) &
+ write(iout,*) "ethetai",ethetai
+ do m=1,ntheterm3_nucl
do k=2,ndouble_nucl
do l=1,k-1
- write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
- sinph1ph2(l,k),sinph1ph2(k,l)
- enddo
- enddo
- write(iout,*) "ethetai",ethetai
- endif
- do m=1,ntheterm2_nucl
- do k=1,nsingle_nucl
- aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
- +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
- +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
- +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
+ aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*aux*coskt(m)
- dephii=dephii+k*sinkt(m)*(&
- ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
- bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
- dephii1=dephii1+k*sinkt(m)*(&
- eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
- ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
- if (lprn) &
- write (iout,*) "m",m," k",k," bbthet",&
- bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
- ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
- ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
- eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
- enddo
- enddo
- if (lprn) &
- write(iout,*) "ethetai",ethetai
- do m=1,ntheterm3_nucl
- do k=2,ndouble_nucl
- do l=1,k-1
- aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
- ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*coskt(m)*aux
- dephii=dephii+l*sinkt(m)*(&
- -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
- dephii1=dephii1+(k-l)*sinkt(m)*( &
- -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
- if (lprn) then
- write (iout,*) "m",m," k",k," l",l," ffthet", &
- ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
- write (iout,*) cosph1ph2(l,k)*sinkt(m), &
- cosph1ph2(k,l)*sinkt(m),&
- sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
- endif
- enddo
+ dethetai=dethetai+0.5d0*m*coskt(m)*aux
+ dephii=dephii+l*sinkt(m)*(&
+ -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
+ dephii1=dephii1+(k-l)*sinkt(m)*( &
+ -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
+ if (lprn) then
+ write (iout,*) "m",m," k",k," l",l," ffthet", &
+ ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
+ write (iout,*) cosph1ph2(l,k)*sinkt(m), &
+ cosph1ph2(k,l)*sinkt(m),&
+ sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
+ endif
enddo
enddo
+ enddo
10 continue
- if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
- i,theta(i)*rad2deg,phii*rad2deg, &
- phii1*rad2deg,ethetai
- etheta_nucl=etheta_nucl+ethetai
+ if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
+ i,theta(i)*rad2deg,phii*rad2deg, &
+ phii1*rad2deg,ethetai
+ etheta_nucl=etheta_nucl+ethetai
! print *,i,"partial sum",etheta_nucl
- if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
- if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
- gloc(nphi+i-2,icg)=wang_nucl*dethetai
+ if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
+ if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
+ gloc(nphi+i-2,icg)=wang_nucl*dethetai
enddo
return
end subroutine ebend_nucl
!----------------------------------------------------
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'
!el local variables
integer :: i,j,iblock,itori,itori1
real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
- vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
+ vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
! Set lprn=.true. for debugging
lprn=.false.
! lprn=.true.
etors_nucl=0.0D0
! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
do i=iphi_nucl_start,iphi_nucl_end
- if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
- .or. itype(i-3,2).eq.ntyp1_molec(2) &
- .or. itype(i,2).eq.ntyp1_molec(2)) cycle
- etors_ii=0.0D0
- itori=itortyp_nucl(itype(i-2,2))
- itori1=itortyp_nucl(itype(i-1,2))
- phii=phi(i)
+ if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
+ .or. itype(i-3,2).eq.ntyp1_molec(2) &
+ .or. itype(i,2).eq.ntyp1_molec(2)) cycle
+ etors_ii=0.0D0
+ itori=itortyp_nucl(itype(i-2,2))
+ itori1=itortyp_nucl(itype(i-1,2))
+ phii=phi(i)
! print *,i,itori,itori1
- gloci=0.0D0
+ gloci=0.0D0
!C Regular cosine and sine terms
- do j=1,nterm_nucl(itori,itori1)
- v1ij=v1_nucl(j,itori,itori1)
- v2ij=v2_nucl(j,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
- if (energy_dec) etors_ii=etors_ii+&
- v1ij*cosphi+v2ij*sinphi
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
+ do j=1,nterm_nucl(itori,itori1)
+ v1ij=v1_nucl(j,itori,itori1)
+ v2ij=v2_nucl(j,itori,itori1)
+ cosphi=dcos(j*phii)
+ sinphi=dsin(j*phii)
+ etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
+ if (energy_dec) etors_ii=etors_ii+&
+ v1ij*cosphi+v2ij*sinphi
+ gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
+ enddo
!C Lorentz terms
!C v1
!C E = SUM ----------------------------------- - v1
!C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
!C
- cosphi=dcos(0.5d0*phii)
- sinphi=dsin(0.5d0*phii)
- do j=1,nlor_nucl(itori,itori1)
- vl1ij=vlor1_nucl(j,itori,itori1)
- vl2ij=vlor2_nucl(j,itori,itori1)
- vl3ij=vlor3_nucl(j,itori,itori1)
- pom=vl2ij*cosphi+vl3ij*sinphi
- pom1=1.0d0/(pom*pom+1.0d0)
- etors_nucl=etors_nucl+vl1ij*pom1
- if (energy_dec) etors_ii=etors_ii+ &
- vl1ij*pom1
- pom=-pom*pom1*pom1
- gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
- enddo
+ cosphi=dcos(0.5d0*phii)
+ sinphi=dsin(0.5d0*phii)
+ do j=1,nlor_nucl(itori,itori1)
+ vl1ij=vlor1_nucl(j,itori,itori1)
+ vl2ij=vlor2_nucl(j,itori,itori1)
+ vl3ij=vlor3_nucl(j,itori,itori1)
+ pom=vl2ij*cosphi+vl3ij*sinphi
+ pom1=1.0d0/(pom*pom+1.0d0)
+ etors_nucl=etors_nucl+vl1ij*pom1
+ if (energy_dec) etors_ii=etors_ii+ &
+ vl1ij*pom1
+ pom=-pom*pom1*pom1
+ gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
+ enddo
!C Subtract the constant term
- etors_nucl=etors_nucl-v0_nucl(itori,itori1)
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
- 'etor',i,etors_ii-v0_nucl(itori,itori1)
- if (lprn) &
+ etors_nucl=etors_nucl-v0_nucl(itori,itori1)
+ if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
+ 'etor',i,etors_ii-v0_nucl(itori,itori1)
+ if (lprn) &
write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
(v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
- gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
+ gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
!c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
enddo
return
!C the orientation of the CA-CA virtual bonds.
!C
integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
- real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
+ real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbbi,sslipi,ssgradlipi, &
+ sslipj,ssgradlipj,faclipij2
real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
- dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
- dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
+ dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
+ dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,sss_grad,fac,evdw1ij
+ dist_temp, dist_init,sss_grad,fac,evdw1ij
integer xshift,yshift,zshift
real(kind=8),dimension(3):: ggg,gggp,gggm,erij
real(kind=8) :: ees,eesij
!c
! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
do i=iatel_s_nucl,iatel_e_nucl
- if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
-
- do j=ielstart_nucl(i),ielend_nucl(i)
- if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
- ind=ind+1
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
+ if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
+ dxi=dc(1,i)
+ dyi=dc(2,i)
+ dzi=dc(3,i)
+ dx_normi=dc_norm(1,i)
+ dy_normi=dc_norm(2,i)
+ dz_normi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+
+ do j=ielstart_nucl(i),ielend_nucl(i)
+ if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
+ ind=ind+1
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
! xj=c(1,j)+0.5D0*dxj-xmedi
! yj=c(2,j)+0.5D0*dyj-ymedi
! zj=c(3,j)+0.5D0*dzj-zmedi
- xj=c(1,j)+0.5D0*dxj
- yj=c(2,j)+0.5D0*dyj
- zj=c(3,j)+0.5D0*dzj
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- isubchap=0
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- isubchap=1
- endif
- enddo
- enddo
- enddo
- if (isubchap.eq.1) then
-!C print *,i,j
- xj=xj_temp-xmedi
- yj=yj_temp-ymedi
- zj=zj_temp-zmedi
- else
- xj=xj_safe-xmedi
- yj=yj_safe-ymedi
- zj=zj_safe-zmedi
- endif
-
- rij=xj*xj+yj*yj+zj*zj
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
+ rij=xj*xj+yj*yj+zj*zj
!c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
- fac=(r0pp**2/rij)**3
- ev1=epspp*fac*fac
- ev2=epspp*fac
- evdw1ij=ev1-2*ev2
- fac=(-ev1-evdw1ij)/rij
+ fac=(r0pp**2/rij)**3
+ ev1=epspp*fac*fac
+ ev2=epspp*fac
+ evdw1ij=ev1-2*ev2
+ fac=(-ev1-evdw1ij)/rij
! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
- if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
- evdw1=evdw1+evdw1ij
+ if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
+ evdw1=evdw1+evdw1ij
!C
!C Calculate contributions to the Cartesian gradient.
!C
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
- do k=1,3
- gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
- gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
- enddo
+ ggg(1)=fac*xj
+ ggg(2)=fac*yj
+ ggg(3)=fac*zj
+ do k=1,3
+ gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
+ gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
+ enddo
!c phoshate-phosphate electrostatic interactions
- rij=dsqrt(rij)
- fac=1.0d0/rij
- eesij=dexp(-BEES*rij)*fac
+ rij=dsqrt(rij)
+ fac=1.0d0/rij
+ eesij=dexp(-BEES*rij)*fac
! write (2,*)"fac",fac," eesijpp",eesij
- if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
- ees=ees+eesij
+ if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
+ ees=ees+eesij
!c fac=-eesij*fac
- fac=-(fac+BEES)*eesij*fac
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
+ fac=-(fac+BEES)*eesij*fac
+ ggg(1)=fac*xj
+ ggg(2)=fac*yj
+ ggg(3)=fac*zj
!c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
!c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
!c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
- do k=1,3
- gelpp(k,i)=gelpp(k,i)-ggg(k)
- gelpp(k,j)=gelpp(k,j)+ggg(k)
- enddo
- enddo ! j
+ do k=1,3
+ gelpp(k,i)=gelpp(k,i)-ggg(k)
+ gelpp(k,j)=gelpp(k,j)+ggg(k)
+ enddo
+ enddo ! j
enddo ! i
!c ees=332.0d0*ees
ees=AEES*ees
do i=nnt,nct
!c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
- do k=1,3
- gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
+ do k=1,3
+ gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
!c gelpp(k,i)=332.0d0*gelpp(k,i)
- gelpp(k,i)=AEES*gelpp(k,i)
- enddo
+ gelpp(k,i)=AEES*gelpp(k,i)
+ enddo
!c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
enddo
!c write (2,*) "total EES",ees
real(kind=8),dimension(3):: ggg
integer :: i,iint,j,k,iteli,itypj,subchap
real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
- e1,e2,evdwij,rij,evdwpsb,eelpsb
+ e1,e2,evdwij,rij,evdwpsb,eelpsb
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init
+ dist_temp, dist_init
integer xshift,yshift,zshift
!cd print '(a)','Enter ESCP'
evdwpsb=0.0d0
! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
do i=iatscp_s_nucl,iatscp_e_nucl
- if (itype(i,2).eq.ntyp1_molec(2) &
- .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
- xi=0.5D0*(c(1,i)+c(1,i+1))
- yi=0.5D0*(c(2,i)+c(2,i+1))
- zi=0.5D0*(c(3,i)+c(3,i+1))
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- do iint=1,nscp_gr_nucl(i)
-
- do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
- itypj=itype(j,2)
- if (itypj.eq.ntyp1_molec(2)) cycle
+ if (itype(i,2).eq.ntyp1_molec(2) &
+ .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
+ xi=0.5D0*(c(1,i)+c(1,i+1))
+ yi=0.5D0*(c(2,i)+c(2,i+1))
+ zi=0.5D0*(c(3,i)+c(3,i+1))
+ call to_box(xi,yi,zi)
+
+ do iint=1,nscp_gr_nucl(i)
+
+ do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
+ itypj=itype(j,2)
+ if (itypj.eq.ntyp1_molec(2)) cycle
!C Uncomment following three lines for SC-p interactions
!c xj=c(1,nres+j)-xi
!c yj=c(2,nres+j)-yi
! xj=c(1,j)-xi
! yj=c(2,j)-yi
! zj=c(3,j)-zi
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,j)
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
-
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac=rrij**expon2
- e1=fac*fac*aad_nucl(itypj)
- e2=fac*bad_nucl(itypj)
- if (iabs(j-i) .le. 2) then
- e1=scal14*e1
- e2=scal14*e2
- endif
- evdwij=e1+e2
- evdwpsb=evdwpsb+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
- 'evdw2',i,j,evdwij,"tu4"
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dist_init=xj**2+yj**2+zj**2
+
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ fac=rrij**expon2
+ e1=fac*fac*aad_nucl(itypj)
+ e2=fac*bad_nucl(itypj)
+ if (iabs(j-i) .le. 2) then
+ e1=scal14*e1
+ e2=scal14*e2
+ endif
+ evdwij=e1+e2
+ evdwpsb=evdwpsb+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
+ 'evdw2',i,j,evdwij,"tu4"
!C
!C Calculate contributions to the gradient in the virtual-bond and SC vectors.
!C
- fac=-(evdwij+e1)*rrij
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
- do k=1,3
- gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
- gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
- enddo
+ fac=-(evdwij+e1)*rrij
+ ggg(1)=xj*fac
+ ggg(2)=yj*fac
+ ggg(3)=zj*fac
+ do k=1,3
+ gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
+ gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
enddo
+ enddo
- enddo ! iint
+ enddo ! iint
enddo ! i
do i=1,nct
- do j=1,3
- gvdwpsb(j,i)=expon*gvdwpsb(j,i)
- gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
- enddo
+ do j=1,3
+ gvdwpsb(j,i)=expon*gvdwpsb(j,i)
+ gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
+ enddo
enddo
return
end subroutine epsb
real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,faclip,sig0ij
+ dist_temp, dist_init,aa,bb,faclip,sig0ij
integer :: ii
logical lprn
evdw=0.0D0
ind=0
! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
do i=iatsc_s_nucl,iatsc_e_nucl
- num_conti=0
- num_conti2=0
- itypi=itype(i,2)
+ num_conti=0
+ num_conti2=0
+ itypi=itype(i,2)
! PRINT *,"I=",i,itypi
- if (itypi.eq.ntyp1_molec(2)) cycle
- itypi1=itype(i+1,2)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=dmod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=dmod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=dmod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
- dsci_inv=vbld_inv(i+nres)
+ if (itypi.eq.ntyp1_molec(2)) cycle
+ itypi1=itype(i+1,2)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ dsci_inv=vbld_inv(i+nres)
!C
!C Calculate SC interaction energy.
!C
- do iint=1,nint_gr_nucl(i)
+ do iint=1,nint_gr_nucl(i)
! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
- do j=istart_nucl(i,iint),iend_nucl(i,iint)
- ind=ind+1
+ do j=istart_nucl(i,iint),iend_nucl(i,iint)
+ ind=ind+1
! print *,"JESTEM"
- itypj=itype(j,2)
- if (itypj.eq.ntyp1_molec(2)) cycle
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma_nucl(itypi,itypj)
- chi1=chi_nucl(itypi,itypj)
- chi2=chi_nucl(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip_nucl(itypi,itypj)
- chip2=chip_nucl(itypj,itypi)
- chip12=chip1*chip2
+ itypj=itype(j,2)
+ if (itypj.eq.ntyp1_molec(2)) cycle
+ dscj_inv=vbld_inv(j+nres)
+ sig0ij=sigma_nucl(itypi,itypj)
+ chi1=chi_nucl(itypi,itypj)
+ chi2=chi_nucl(itypj,itypi)
+ chi12=chi1*chi2
+ chip1=chip_nucl(itypi,itypj)
+ chip2=chip_nucl(itypj,itypi)
+ chip12=chip1*chip2
! xj=c(1,nres+j)-xi
! yj=c(2,nres+j)-yi
! zj=c(3,nres+j)-zi
- xj=c(1,nres+j)
- yj=c(2,nres+j)
- zj=c(3,nres+j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
-
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dxj=dc_norm(1,nres+j)
+ dyj=dc_norm(2,nres+j)
+ dzj=dc_norm(3,nres+j)
+ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+ rij=dsqrt(rrij)
!C Calculate angle-dependent terms of energy and contributions to their
!C derivatives.
- erij(1)=xj*rij
- erij(2)=yj*rij
- erij(3)=zj*rij
- om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
- om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
- om12=dxi*dxj+dyi*dyj+dzi*dzj
- call sc_angular_nucl
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
+ erij(1)=xj*rij
+ erij(2)=yj*rij
+ erij(3)=zj*rij
+ om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
+ om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
+ om12=dxi*dxj+dyi*dyj+dzi*dzj
+ call sc_angular_nucl
+ sigsq=1.0D0/sigsq
+ sig=sig0ij*dsqrt(sigsq)
+ rij_shift=1.0D0/rij-sig+sig0ij
! print *,rij_shift,"rij_shift"
!c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
!c & " rij_shift",rij_shift
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
+ if (rij_shift.le.0.0D0) then
+ evdw=1.0D20
+ return
+ endif
+ sigder=-sig*sigsq
!c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa_nucl(itypi,itypj)
- e2=fac*bb_nucl(itypi,itypj)
- evdwij=eps1*eps2rt*(e1+e2)
+ rij_shift=1.0D0/rij_shift
+ fac=rij_shift**expon
+ e1=fac*fac*aa_nucl(itypi,itypj)
+ e2=fac*bb_nucl(itypi,itypj)
+ evdwij=eps1*eps2rt*(e1+e2)
!c write (2,*) "eps1",eps1," eps2rt",eps2rt,
!c & " e1",e1," e2",e2," evdwij",evdwij
- eps2der=evdwij
- evdwij=evdwij*eps2rt
- evdwsb=evdwsb+evdwij
- if (lprn) then
- sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
- restyp(itypi,2),i,restyp(itypj,2),j, &
- epsi,sigm,chi1,chi2,chip1,chip2, &
- eps1,eps2rt**2,sig,sig0ij, &
- om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
- evdwij
- write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
- endif
+ eps2der=evdwij
+ evdwij=evdwij*eps2rt
+ evdwsb=evdwsb+evdwij
+ if (lprn) then
+ sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
+ epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
+ write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
+ restyp(itypi,2),i,restyp(itypj,2),j, &
+ epsi,sigm,chi1,chi2,chip1,chip2, &
+ eps1,eps2rt**2,sig,sig0ij, &
+ om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
+ evdwij
+ write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
+ endif
- if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
- 'evdw',i,j,evdwij,"tu3"
+ if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
+ 'evdw',i,j,evdwij,"tu3"
!C Calculate gradient components.
- e1=e1*eps1*eps2rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
+ e1=e1*eps1*eps2rt**2
+ fac=-expon*(e1+evdwij)*rij_shift
+ sigder=fac*sigder
+ fac=rij*fac
!c fac=0.0d0
!C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
+ gg(1)=xj*fac
+ gg(2)=yj*fac
+ gg(3)=zj*fac
!C Calculate angular part of the gradient.
- call sc_grad_nucl
- call eelsbij(eelij,num_conti2)
- if (energy_dec .and. &
- (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
- write (istat,'(e14.5)') evdwij
- eelsb=eelsb+eelij
- enddo ! j
- enddo ! iint
- num_cont_hb(i)=num_conti2
+ call sc_grad_nucl
+ call eelsbij(eelij,num_conti2)
+ if (energy_dec .and. &
+ (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
+ write (istat,'(e14.5)') evdwij
+ eelsb=eelsb+eelij
+ enddo ! j
+ enddo ! iint
+ num_cont_hb(i)=num_conti2
enddo ! i
!c write (iout,*) "Number of loop steps in EGB:",ind
!cccc energy_dec=.false.
real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,rlocshield,fracinbuf
+ dist_temp, dist_init,rlocshield,fracinbuf
integer xshift,yshift,zshift,ilist,iresshield,num_conti2
!c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
real(kind=8) :: dx_normj,dy_normj,dz_normj,&
- r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
- el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
- ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
- a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
- ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
- ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
- ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
+ r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
+ el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
+ ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
+ a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
+ ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
+ ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
+ ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
ind=ind+1
itypi=itype(i,2)
itypj=itype(j,2)
!c yj=c(2,j)+0.5D0*dyj-ymedi
!c zj=c(3,j)+0.5D0*dzj-zmedi
if (ipot_nucl.ne.2) then
- cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
- cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
- cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
+ cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
+ cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
+ cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
else
- cosa=om12
- cosb=om1
- cosg=om2
+ cosa=om12
+ cosb=om1
+ cosg=om2
endif
r3ij=rij*rrij
r6ij=r3ij*r3ij
ees0ij=4.0D0+facfac-fac1
if (energy_dec) then
- if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
- write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
- sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
- restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
- (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
- write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
+ if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
+ write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
+ sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
+ restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
+ (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
+ write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
endif
!C
ggg(2)=facel*yj
ggg(3)=facel*zj
do k=1,3
- gelsbc(k,j)=gelsbc(k,j)+ggg(k)
- gelsbc(k,i)=gelsbc(k,i)-ggg(k)
- gelsbx(k,j)=gelsbx(k,j)+ggg(k)
- gelsbx(k,i)=gelsbx(k,i)-ggg(k)
+ gelsbc(k,j)=gelsbc(k,j)+ggg(k)
+ gelsbc(k,i)=gelsbc(k,i)-ggg(k)
+ gelsbx(k,j)=gelsbx(k,j)+ggg(k)
+ gelsbx(k,i)=gelsbx(k,i)-ggg(k)
enddo
!*
!* Angular part
ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
fac6*fac1*cosb
do k=1,3
- dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
- dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
+ dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
+ dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
enddo
do k=1,3
- ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
+ ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
enddo
do k=1,3
- gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
- +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
- + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
- gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
- +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
- + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
- gelsbc(k,j)=gelsbc(k,j)+ggg(k)
- gelsbc(k,i)=gelsbc(k,i)-ggg(k)
+ gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
+ +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
+ + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
+ gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
+ +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
+ + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
+ gelsbc(k,j)=gelsbc(k,j)+ggg(k)
+ gelsbc(k,i)=gelsbc(k,i)-ggg(k)
enddo
! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
IF ( j.gt.i+1 .and.&
- num_conti.le.maxcont) THEN
+ num_conti.le.maxcont) THEN
!C
!C Calculate the contact function. The ith column of the array JCONT will
!C contain the numbers of atoms that make contacts with the atom I (of numbers
!C greater than I). The arrays FACONT and GACONT will contain the values of
!C the contact function and its derivative.
- r0ij=2.20D0*sigma_nucl(itypi,itypj)
+ r0ij=2.20D0*sigma_nucl(itypi,itypj)
!c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
- call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
+ call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
!c write (2,*) "fcont",fcont
- if (fcont.gt.0.0D0) then
- num_conti=num_conti+1
- num_conti2=num_conti2+1
+ if (fcont.gt.0.0D0) then
+ num_conti=num_conti+1
+ num_conti2=num_conti2+1
- if (num_conti.gt.maxconts) then
- write (iout,*) 'WARNING - max. # of contacts exceeded;',&
- ' will skip next contacts for this conf.',maxconts
- else
- jcont_hb(num_conti,i)=j
+ if (num_conti.gt.maxconts) then
+ write (iout,*) 'WARNING - max. # of contacts exceeded;',&
+ ' will skip next contacts for this conf.',maxconts
+ else
+ jcont_hb(num_conti,i)=j
!c write (iout,*) "num_conti",num_conti,
!c & " jcont_hb",jcont_hb(num_conti,i)
!C Calculate contact energies
- cosa4=4.0D0*cosa
- wij=cosa-3.0D0*cosb*cosg
- cosbg1=cosb+cosg
- cosbg2=cosb-cosg
- fac3=dsqrt(-ael6i)*r3ij
+ cosa4=4.0D0*cosa
+ wij=cosa-3.0D0*cosb*cosg
+ cosbg1=cosb+cosg
+ cosbg2=cosb-cosg
+ fac3=dsqrt(-ael6i)*r3ij
!c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
- ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
- if (ees0tmp.gt.0) then
- ees0pij=dsqrt(ees0tmp)
- else
- ees0pij=0
- endif
- ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
- if (ees0tmp.gt.0) then
- ees0mij=dsqrt(ees0tmp)
- else
- ees0mij=0
- endif
- ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
- ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
+ ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
+ if (ees0tmp.gt.0) then
+ ees0pij=dsqrt(ees0tmp)
+ else
+ ees0pij=0
+ endif
+ ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
+ if (ees0tmp.gt.0) then
+ ees0mij=dsqrt(ees0tmp)
+ else
+ ees0mij=0
+ endif
+ ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
+ ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
!c write (iout,*) "i",i," j",j,
!c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
- ees0pij1=fac3/ees0pij
- ees0mij1=fac3/ees0mij
- fac3p=-3.0D0*fac3*rrij
- ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
- ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
- ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
- ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
- ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
- ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
- ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
- ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
- ecosap=ecosa1+ecosa2
- ecosbp=ecosb1+ecosb2
- ecosgp=ecosg1+ecosg2
- ecosam=ecosa1-ecosa2
- ecosbm=ecosb1-ecosb2
- ecosgm=ecosg1-ecosg2
+ ees0pij1=fac3/ees0pij
+ ees0mij1=fac3/ees0mij
+ fac3p=-3.0D0*fac3*rrij
+ ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
+ ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
+ ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
+ ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
+ ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
+ ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
+ ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
+ ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
+ ecosap=ecosa1+ecosa2
+ ecosbp=ecosb1+ecosb2
+ ecosgp=ecosg1+ecosg2
+ ecosam=ecosa1-ecosa2
+ ecosbm=ecosb1-ecosb2
+ ecosgm=ecosg1-ecosg2
!C End diagnostics
- facont_hb(num_conti,i)=fcont
- fprimcont=fprimcont/rij
- do k=1,3
- gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
- gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
- enddo
- gggp(1)=gggp(1)+ees0pijp*xj
- gggp(2)=gggp(2)+ees0pijp*yj
- gggp(3)=gggp(3)+ees0pijp*zj
- gggm(1)=gggm(1)+ees0mijp*xj
- gggm(2)=gggm(2)+ees0mijp*yj
- gggm(3)=gggm(3)+ees0mijp*zj
+ facont_hb(num_conti,i)=fcont
+ fprimcont=fprimcont/rij
+ do k=1,3
+ gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
+ gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
+ enddo
+ gggp(1)=gggp(1)+ees0pijp*xj
+ gggp(2)=gggp(2)+ees0pijp*yj
+ gggp(3)=gggp(3)+ees0pijp*zj
+ gggm(1)=gggm(1)+ees0mijp*xj
+ gggm(2)=gggm(2)+ees0mijp*yj
+ gggm(3)=gggm(3)+ees0mijp*zj
!C Derivatives due to the contact function
- gacont_hbr(1,num_conti,i)=fprimcont*xj
- gacont_hbr(2,num_conti,i)=fprimcont*yj
- gacont_hbr(3,num_conti,i)=fprimcont*zj
- do k=1,3
+ gacont_hbr(1,num_conti,i)=fprimcont*xj
+ gacont_hbr(2,num_conti,i)=fprimcont*yj
+ gacont_hbr(3,num_conti,i)=fprimcont*zj
+ do k=1,3
!c
!c Gradient of the correlation terms
!c
- gacontp_hb1(k,num_conti,i)= &
- (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
- + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
- gacontp_hb2(k,num_conti,i)= &
- (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
- + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
- gacontp_hb3(k,num_conti,i)=gggp(k)
- gacontm_hb1(k,num_conti,i)= &
- (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
- + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
- gacontm_hb2(k,num_conti,i)= &
- (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
- + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
- gacontm_hb3(k,num_conti,i)=gggm(k)
- enddo
- endif
+ gacontp_hb1(k,num_conti,i)= &
+ (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
+ + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
+ gacontp_hb2(k,num_conti,i)= &
+ (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
+ + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
+ gacontp_hb3(k,num_conti,i)=gggp(k)
+ gacontm_hb1(k,num_conti,i)= &
+ (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
+ + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
+ gacontm_hb2(k,num_conti,i)= &
+ (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
+ + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
+ gacontm_hb3(k,num_conti,i)=gggm(k)
+ enddo
endif
+ endif
ENDIF
return
end subroutine eelsbij
eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
+ dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
+ dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
enddo
do k=1,3
- gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
+ gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
enddo
do k=1,3
- gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
- +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
- +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
- +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
+ +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
+ +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
enddo
!C
!C Calculate the components of the gradient in DC and X
!C
do l=1,3
- gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
- gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
+ gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
+ gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
enddo
return
end subroutine sc_grad_nucl
delta=0.02d0*pi
esbloc=0.0D0
do i=loc_start_nucl,loc_end_nucl
- if (itype(i,2).eq.ntyp1_molec(2)) cycle
- costtab(i+1) =dcos(theta(i+1))
- sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
- cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
- sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
- cosfac2=0.5d0/(1.0d0+costtab(i+1))
- cosfac=dsqrt(cosfac2)
- sinfac2=0.5d0/(1.0d0-costtab(i+1))
- sinfac=dsqrt(sinfac2)
- it=itype(i,2)
- if (it.eq.10) goto 1
+ if (itype(i,2).eq.ntyp1_molec(2)) cycle
+ costtab(i+1) =dcos(theta(i+1))
+ sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
+ cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
+ sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
+ cosfac2=0.5d0/(1.0d0+costtab(i+1))
+ cosfac=dsqrt(cosfac2)
+ sinfac2=0.5d0/(1.0d0-costtab(i+1))
+ sinfac=dsqrt(sinfac2)
+ it=itype(i,2)
+ if (it.eq.10) goto 1
!c
!C Compute the axes of tghe local cartesian coordinates system; store in
!c x_prime, y_prime and z_prime
!c
- do j=1,3
- x_prime(j) = 0.00
- y_prime(j) = 0.00
- z_prime(j) = 0.00
- enddo
+ do j=1,3
+ x_prime(j) = 0.00
+ y_prime(j) = 0.00
+ z_prime(j) = 0.00
+ enddo
!C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
!C & dc_norm(3,i+nres)
- do j = 1,3
- x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
- y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
- enddo
- do j = 1,3
- z_prime(j) = -uz(j,i-1)
+ do j = 1,3
+ x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
+ y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
+ enddo
+ do j = 1,3
+ z_prime(j) = -uz(j,i-1)
! z_prime(j)=0.0
- enddo
+ enddo
- xx=0.0d0
- yy=0.0d0
- zz=0.0d0
- do j = 1,3
- xx = xx + x_prime(j)*dc_norm(j,i+nres)
- yy = yy + y_prime(j)*dc_norm(j,i+nres)
- zz = zz + z_prime(j)*dc_norm(j,i+nres)
- enddo
+ xx=0.0d0
+ yy=0.0d0
+ zz=0.0d0
+ do j = 1,3
+ xx = xx + x_prime(j)*dc_norm(j,i+nres)
+ yy = yy + y_prime(j)*dc_norm(j,i+nres)
+ zz = zz + z_prime(j)*dc_norm(j,i+nres)
+ enddo
- xxtab(i)=xx
- yytab(i)=yy
- zztab(i)=zz
- it=itype(i,2)
- do j = 1,9
- x(j) = sc_parmin_nucl(j,it)
- enddo
+ xxtab(i)=xx
+ yytab(i)=yy
+ zztab(i)=zz
+ it=itype(i,2)
+ do j = 1,9
+ x(j) = sc_parmin_nucl(j,it)
+ enddo
#ifdef CHECK_COORD
!Cc diagnostics - remove later
- xx1 = dcos(alph(2))
- yy1 = dsin(alph(2))*dcos(omeg(2))
- zz1 = -dsin(alph(2))*dsin(omeg(2))
- write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
- alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
- xx1,yy1,zz1
+ xx1 = dcos(alph(2))
+ yy1 = dsin(alph(2))*dcos(omeg(2))
+ zz1 = -dsin(alph(2))*dsin(omeg(2))
+ write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
+ alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
+ xx1,yy1,zz1
!C," --- ", xx_w,yy_w,zz_w
!c end diagnostics
#endif
- sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- esbloc = esbloc + sumene
- sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
+ sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ esbloc = esbloc + sumene
+ sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
! print *,"enecomp",sumene,sumene2
-! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
+ if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
#ifdef DEBUG
- write (2,*) "x",(x(k),k=1,9)
+ write (2,*) "x",(x(k),k=1,9)
!C
!C This section to check the numerical derivatives of the energy of ith side
!C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
!C #define DEBUG in the code to turn it on.
!C
- write (2,*) "sumene =",sumene
- aincr=1.0d-7
- xxsave=xx
- xx=xx+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dxx_num=(sumenep-sumene)/aincr
- xx=xxsave
- write (2,*) "xx+ sumene from enesc=",sumenep,sumene
- yysave=yy
- yy=yy+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dyy_num=(sumenep-sumene)/aincr
- yy=yysave
- write (2,*) "yy+ sumene from enesc=",sumenep,sumene
- zzsave=zz
- zz=zz+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dzz_num=(sumenep-sumene)/aincr
- zz=zzsave
- write (2,*) "zz+ sumene from enesc=",sumenep,sumene
- costsave=cost2tab(i+1)
- sintsave=sint2tab(i+1)
- cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
- sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dt_num=(sumenep-sumene)/aincr
- write (2,*) " t+ sumene from enesc=",sumenep,sumene
- cost2tab(i+1)=costsave
- sint2tab(i+1)=sintsave
+ write (2,*) "sumene =",sumene
+ aincr=1.0d-7
+ xxsave=xx
+ xx=xx+aincr
+ write (2,*) xx,yy,zz
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dxx_num=(sumenep-sumene)/aincr
+ xx=xxsave
+ write (2,*) "xx+ sumene from enesc=",sumenep,sumene
+ yysave=yy
+ yy=yy+aincr
+ write (2,*) xx,yy,zz
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dyy_num=(sumenep-sumene)/aincr
+ yy=yysave
+ write (2,*) "yy+ sumene from enesc=",sumenep,sumene
+ zzsave=zz
+ zz=zz+aincr
+ write (2,*) xx,yy,zz
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dzz_num=(sumenep-sumene)/aincr
+ zz=zzsave
+ write (2,*) "zz+ sumene from enesc=",sumenep,sumene
+ costsave=cost2tab(i+1)
+ sintsave=sint2tab(i+1)
+ cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
+ sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dt_num=(sumenep-sumene)/aincr
+ write (2,*) " t+ sumene from enesc=",sumenep,sumene
+ cost2tab(i+1)=costsave
+ sint2tab(i+1)=sintsave
!C End of diagnostics section.
#endif
!C
!C Compute the gradient of esc
!C
- de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
- de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
- de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
- de_dtt=0.0d0
+ de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
+ de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
+ de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
+ de_dtt=0.0d0
#ifdef DEBUG
- write (2,*) "x",(x(k),k=1,9)
- write (2,*) "xx",xx," yy",yy," zz",zz
- write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
- " de_zz ",de_zz," de_tt ",de_tt
- write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
- " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
+ write (2,*) "x",(x(k),k=1,9)
+ write (2,*) "xx",xx," yy",yy," zz",zz
+ write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
+ " de_zz ",de_zz," de_tt ",de_tt
+ write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
+ " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
#endif
!C
cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
cosfac2xx=cosfac2*xx
sinfac2yy=sinfac2*yy
do k = 1,3
- dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
- vbld_inv(i+1)
- dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
- vbld_inv(i)
- pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
- pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
+ dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
+ vbld_inv(i+1)
+ dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
+ vbld_inv(i)
+ pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
+ pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
!c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
!c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
!c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
!c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
- dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
- dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
- dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
- dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
- dZZ_Ci1(k)=0.0d0
- dZZ_Ci(k)=0.0d0
- do j=1,3
- dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
- dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
- enddo
+ dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
+ dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
+ dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
+ dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
+ dZZ_Ci1(k)=0.0d0
+ dZZ_Ci(k)=0.0d0
+ do j=1,3
+ dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
+ dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
+ enddo
- dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
- dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
- dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
+ dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
+ dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
+ dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
!c
- dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
- dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
+ dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
+ dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
enddo
do k=1,3
- dXX_Ctab(k,i)=dXX_Ci(k)
- dXX_C1tab(k,i)=dXX_Ci1(k)
- dYY_Ctab(k,i)=dYY_Ci(k)
- dYY_C1tab(k,i)=dYY_Ci1(k)
- dZZ_Ctab(k,i)=dZZ_Ci(k)
- dZZ_C1tab(k,i)=dZZ_Ci1(k)
- dXX_XYZtab(k,i)=dXX_XYZ(k)
- dYY_XYZtab(k,i)=dYY_XYZ(k)
- dZZ_XYZtab(k,i)=dZZ_XYZ(k)
+ dXX_Ctab(k,i)=dXX_Ci(k)
+ dXX_C1tab(k,i)=dXX_Ci1(k)
+ dYY_Ctab(k,i)=dYY_Ci(k)
+ dYY_C1tab(k,i)=dYY_Ci1(k)
+ dZZ_Ctab(k,i)=dZZ_Ci(k)
+ dZZ_C1tab(k,i)=dZZ_Ci1(k)
+ dXX_XYZtab(k,i)=dXX_XYZ(k)
+ dYY_XYZtab(k,i)=dYY_XYZ(k)
+ dZZ_XYZtab(k,i)=dZZ_XYZ(k)
enddo
do k = 1,3
!c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
!c & dt_dci(k)
!c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
!c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
- gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
- +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
- gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
- +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
- gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
- +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
+ gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
+ +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
+ gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
+ +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
+ gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
+ +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
enddo
!c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
!c write (2,*) "x",(x(i),i=1,9)
!c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
- + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
- + x(9)*yy*zz
+ + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
+ + x(9)*yy*zz
enesc_nucl=sumene
return
end function enesc_nucl
if (nfgtasks.le.1) goto 30
if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-1
- write (iout,'(2i3,50(1x,i2,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
- j=1,num_cont_hb(i))
- enddo
+ write (iout,'(a)') 'Contact function values:'
+ do i=nnt,nct-1
+ write (iout,'(2i3,50(1x,i2,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
+ j=1,num_cont_hb(i))
+ enddo
endif
!C Caution! Following code assumes that electrostatic interactions concerning
!C a given atom are split among at most two processors!
CorrelID=fg_rank+1
ldone=.false.
do i=1,max_cont
- do j=1,max_dim
- buffer(i,j)=0.0D0
- enddo
+ do j=1,max_dim
+ buffer(i,j)=0.0D0
+ enddo
enddo
mm=mod(fg_rank,2)
!c write (*,*) 'MyRank',MyRank,' mm',mm
!c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
if (fg_rank.gt.0) then
!C Send correlation contributions to the preceding processor
- msglen=msglen1
- nn=num_cont_hb(iatel_s_nucl)
- call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
+ msglen=msglen1
+ nn=num_cont_hb(iatel_s_nucl)
+ call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
!c write (*,*) 'The BUFFER array:'
!c do i=1,nn
!c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
!c enddo
- if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
- msglen=msglen2
- call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
+ if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
+ msglen=msglen2
+ call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
!C Clear the contacts of the atom passed to the neighboring processor
- nn=num_cont_hb(iatel_s_nucl+1)
+ nn=num_cont_hb(iatel_s_nucl+1)
!c do i=1,nn
!c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
!c enddo
- num_cont_hb(iatel_s_nucl)=0
- endif
+ num_cont_hb(iatel_s_nucl)=0
+ endif
!cd write (iout,*) 'Processor ',fg_rank,MyRank,
!cd & ' is sending correlation contribution to processor',fg_rank-1,
!cd & ' msglen=',msglen
!c write (*,*) 'Processor ',fg_rank,MyRank,
!c & ' is sending correlation contribution to processor',fg_rank-1,
!c & ' msglen=',msglen,' CorrelType=',CorrelType
- time00=MPI_Wtime()
- call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
- CorrelType,FG_COMM,IERROR)
- time_sendrecv=time_sendrecv+MPI_Wtime()-time00
+ time00=MPI_Wtime()
+ call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
+ CorrelType,FG_COMM,IERROR)
+ time_sendrecv=time_sendrecv+MPI_Wtime()-time00
!cd write (iout,*) 'Processor ',fg_rank,
!cd & ' has sent correlation contribution to processor',fg_rank-1,
!cd & ' msglen=',msglen,' CorrelID=',CorrelID
!c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
if (fg_rank.lt.nfgtasks-1) then
!C Receive correlation contributions from the next processor
- msglen=msglen1
- if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
+ msglen=msglen1
+ if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
!cd write (iout,*) 'Processor',fg_rank,
!cd & ' is receiving correlation contribution from processor',fg_rank+1,
!cd & ' msglen=',msglen,' CorrelType=',CorrelType
!c write (*,*) 'Processor',fg_rank,
!c &' is receiving correlation contribution from processor',fg_rank+1,
!c & ' msglen=',msglen,' CorrelType=',CorrelType
- time00=MPI_Wtime()
- nbytes=-1
- do while (nbytes.le.0)
- call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
- call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
- enddo
+ time00=MPI_Wtime()
+ nbytes=-1
+ do while (nbytes.le.0)
+ call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
+ call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
+ enddo
!c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
- call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
- fg_rank+1,CorrelType,FG_COMM,status,IERROR)
- time_sendrecv=time_sendrecv+MPI_Wtime()-time00
+ call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
+ fg_rank+1,CorrelType,FG_COMM,status,IERROR)
+ time_sendrecv=time_sendrecv+MPI_Wtime()-time00
!c write (*,*) 'Processor',fg_rank,
!c &' has received correlation contribution from processor',fg_rank+1,
!c & ' msglen=',msglen,' nbytes=',nbytes
!c do i=1,max_cont
!c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
!c enddo
- if (msglen.eq.msglen1) then
- call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
- else if (msglen.eq.msglen2) then
- call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
- call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
- else
- write (iout,*) &
+ if (msglen.eq.msglen1) then
+ call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
+ else if (msglen.eq.msglen2) then
+ call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
+ call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
+ else
+ write (iout,*) &
'ERROR!!!! message length changed while processing correlations.'
- write (*,*) &
+ write (*,*) &
'ERROR!!!! message length changed while processing correlations.'
- call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
- endif ! msglen.eq.msglen1
+ call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
+ endif ! msglen.eq.msglen1
endif ! fg_rank.lt.nfgtasks-1
if (ldone) goto 30
ldone=.true.
30 continue
#endif
if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt_molec(2),nct_molec(2)-1
- write (iout,'(2i3,50(1x,i2,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
- j=1,num_cont_hb(i))
- enddo
+ write (iout,'(a)') 'Contact function values:'
+ do i=nnt_molec(2),nct_molec(2)-1
+ write (iout,'(2i3,50(1x,i2,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
+ j=1,num_cont_hb(i))
+ enddo
endif
ecorr=0.0D0
ecorr3=0.0d0
! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
!C Calculate the local-electrostatic correlation terms
do i=iatsc_s_nucl,iatsc_e_nucl
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
+ i1=i+1
+ num_conti=num_cont_hb(i)
+ num_conti1=num_cont_hb(i+1)
! print *,i,num_conti,num_conti1
- do jj=1,num_conti
- j=jcont_hb(jj,i)
- do kk=1,num_conti1
- j1=jcont_hb(kk,i1)
+ do jj=1,num_conti
+ j=jcont_hb(jj,i)
+ do kk=1,num_conti1
+ j1=jcont_hb(kk,i1)
!c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
!c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1 .or. j1.eq.j-1) then
+ if (j1.eq.j+1 .or. j1.eq.j-1) then
!C
!C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
!C The system gains extra energy.
!C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
!C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
!C
- ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
- 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
- n_corr=n_corr+1
- else if (j1.eq.j) then
+ ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
+ 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
+ n_corr=n_corr+1
+ else if (j1.eq.j) then
!C
!C Contacts I-J and I-(J+1) occur simultaneously.
!C The system loses extra energy.
!C
!c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
!c & ' jj=',jj,' kk=',kk
- ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
- endif
- enddo ! kk
- do kk=1,num_conti
- j1=jcont_hb(kk,i)
+ ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
+ endif
+ enddo ! kk
+ do kk=1,num_conti
+ j1=jcont_hb(kk,i)
!c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
!c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1) then
+ if (j1.eq.j+1) then
!C Contacts I-J and (I+1)-J occur simultaneously.
!C The system loses extra energy.
- ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
- endif ! j1==j+1
- enddo ! kk
- enddo ! jj
+ ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
+ endif ! j1==j+1
+ enddo ! kk
+ enddo ! jj
enddo ! i
return
end subroutine multibody_hb_nucl
!-----------------------------------------------------------
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'
!el local variables
integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
- ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
- coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
- rlocshield
+ ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
+ coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
+ rlocshield
lprn=.false.
eij=facont_hb(jj,i)
coeffpees0pkl=coeffp*ees0pkl
coeffmees0mkl=coeffm*ees0mkl
do ll=1,3
- gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
+ gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
-ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
coeffmees0mkl*gacontm_hb1(ll,jj,i))
- gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
- -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
- coeffmees0mkl*gacontm_hb2(ll,jj,i))
- gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
- -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
- coeffmees0mij*gacontm_hb1(ll,kk,k))
- gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
- -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb2(ll,kk,k))
- gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
- ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb3(ll,jj,i))
- gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
- gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
- gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
- ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb3(ll,kk,k))
- gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
- gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
- gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
- gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
- gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
- gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
+ gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
+ -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
+ coeffmees0mkl*gacontm_hb2(ll,jj,i))
+ gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
+ -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
+ coeffmees0mij*gacontm_hb1(ll,kk,k))
+ gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
+ -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb2(ll,kk,k))
+ gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
+ ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb3(ll,jj,i))
+ gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
+ gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
+ gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
+ ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb3(ll,kk,k))
+ gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
+ gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
+ gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
+ gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
+ gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
+ gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
enddo
ehbcorr_nucl=ekont*ees
return
!-------------------------------------------------------------------------
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'
!el local variables
integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
- ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
- coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
- rlocshield
+ ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
+ coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
+ rlocshield
lprn=.false.
eij=facont_hb(jj,i)
coeffpees0pkl=coeffp*ees0pkl
coeffmees0mkl=coeffm*ees0mkl
do ll=1,3
- gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
+ gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
-ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
coeffmees0mkl*gacontm_hb1(ll,jj,i))
- gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
- -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb2(ll,jj,i))
- gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
- -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb1(ll,kk,k))
- gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
- -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb2(ll,kk,k))
- gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
- ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb3(ll,jj,i))
- gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
- gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
- gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
- ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb3(ll,kk,k))
- gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
- gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
- gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
- gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
- gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
- gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
+ gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
+ -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb2(ll,jj,i))
+ gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
+ -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb1(ll,kk,k))
+ gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
+ -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb2(ll,kk,k))
+ gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
+ ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb3(ll,jj,i))
+ gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
+ gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
+ gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
+ ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb3(ll,kk,k))
+ gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
+ gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
+ gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
+ gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
+ gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
+ gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
enddo
ehbcorr3_nucl=ekont*ees
return
real(kind=8):: buffer(dimen1,dimen2)
num_kont=num_cont_hb(atom)
do i=1,num_kont
- do k=1,8
- do j=1,3
- buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
- enddo ! j
- enddo ! k
- buffer(i,indx+25)=facont_hb(i,atom)
- buffer(i,indx+26)=ees0p(i,atom)
- buffer(i,indx+27)=ees0m(i,atom)
- buffer(i,indx+28)=d_cont(i,atom)
- buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
+ do k=1,8
+ do j=1,3
+ buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
+ enddo ! j
+ enddo ! k
+ buffer(i,indx+25)=facont_hb(i,atom)
+ buffer(i,indx+26)=ees0p(i,atom)
+ buffer(i,indx+27)=ees0m(i,atom)
+ buffer(i,indx+28)=d_cont(i,atom)
+ buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
enddo ! i
buffer(1,indx+30)=dfloat(num_kont)
return
num_kont_old=num_cont_hb(atom)
num_cont_hb(atom)=num_kont+num_kont_old
do i=1,num_kont
- ii=i+num_kont_old
- do k=1,8
- do j=1,3
- zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
- enddo ! j
- enddo ! k
- facont_hb(ii,atom)=buffer(i,indx+25)
- ees0p(ii,atom)=buffer(i,indx+26)
- ees0m(ii,atom)=buffer(i,indx+27)
- d_cont(i,atom)=buffer(i,indx+28)
- jcont_hb(ii,atom)=buffer(i,indx+29)
+ ii=i+num_kont_old
+ do k=1,8
+ do j=1,3
+ zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
+ enddo ! j
+ enddo ! k
+ facont_hb(ii,atom)=buffer(i,indx+25)
+ ees0p(ii,atom)=buffer(i,indx+26)
+ ees0m(ii,atom)=buffer(i,indx+27)
+ d_cont(i,atom)=buffer(i,indx+28)
+ jcont_hb(ii,atom)=buffer(i,indx+29)
enddo ! i
return
end subroutine unpack_buffer
!c------------------------------------------------------------------------------
#endif
subroutine ecatcat(ecationcation)
- integer :: i,j,itmp,xshift,yshift,zshift,subchap,k,itypi,itypj
- real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
- r7,r4,ecationcation,k0,rcal
- real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
- dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
- real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
- gg,r
-
- ecationcation=0.0d0
- if (nres_molec(5).eq.0) return
- rcat0=3.472
- epscalc=0.05
- r06 = rcat0**6
- r012 = r06**2
+ use MD_data, only: t_bath
+ integer :: i,j,itmp,xshift,yshift,zshift,subchap,k,itypi,itypj,irdiff,&
+ ii
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
+ r7,r4,ecationcation,k0,rcal,aa,bb,sslipi,ssgradlipi,sslipj,ssgradlipj
+ real(kind=8) :: xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
+ dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
+ real(kind=8) :: awat,bwat,cwat,dwat,sss2min2,sss2mingrad2,rdiff,ewater
+ real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
+ gg,r
+
+ ecationcation=0.0d0
+ if (nres_molec(5).le.1) return
+ rcat0=3.472
+ epscalc=0.05
+ r06 = rcat0**6
+ r012 = r06**2
! k0 = 332.0*(2.0*2.0)/80.0
- itmp=0
-
- do i=1,4
- itmp=itmp+nres_molec(i)
- enddo
-! write(iout,*) "itmp",itmp
- do i=itmp+1,itmp+nres_molec(5)-1
-
- xi=c(1,i)
- yi=c(2,i)
- zi=c(3,i)
- itypi=itype(i,5)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- do j=i+1,itmp+nres_molec(5)
- itypj=itype(j,5)
- k0 = 332.0*(ichargecat(itypi)*ichargecat(itypj))/80.0
+ itmp=0
+
+! do i=1,4
+! itmp=itmp+nres_molec(i)
+! enddo
+! write(iout,*) "itmp",g_listcatcatnorm_start, g_listcatcatnorm_end
+! do i=itmp+1,itmp+nres_molec(5)-1
+ do ii=g_listcatcatnorm_start, g_listcatcatnorm_end
+ i=newcontlistcatcatnormi(ii)
+ j=newcontlistcatcatnormj(ii)
+
+ xi=c(1,i)
+ yi=c(2,i)
+ zi=c(3,i)
+! write (iout,*) i,"TUTUT",c(1,i)
+ itypi=itype(i,5)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+! do j=i+1,itmp+nres_molec(5)
+ itypj=itype(j,5)
+! print *,i,j,itypi,itypj
+ k0 = 332.0*(ichargecat(itypi)*ichargecat(itypj))/80.0
! print *,i,j,'catcat'
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
-! write(iout,*) c(1,i),xi,xj,"xy",boxxsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rcal =xj**2+yj**2+zj**2
- ract=sqrt(rcal)
+ ract=sqrt(rcal)
+ if ((itypi.gt.1).or.(itypj.gt.1)) then
+ if (sss2min2.eq.0.0d0) cycle
+ sss2min2=sscale2(ract,12.0d0,1.0d0)
+ sss2mingrad2=sscagrad2(ract,12.0d0,1.0d0)
! rcat0=3.472
! epscalc=0.05
! r06 = rcat0**6
! r012 = r06**2
! k0 = 332*(2*2)/80
- Evan1cat=epscalc*(r012/rcal**6)
- Evan2cat=epscalc*2*(r06/rcal**3)
- Eeleccat=k0/ract
- r7 = rcal**7
- r4 = rcal**4
- r(1)=xj
- r(2)=yj
- r(3)=zj
- do k=1,3
- dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
- dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
- dEeleccat(k)=-k0*r(k)/ract**3
- enddo
- do k=1,3
- gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
- gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
- gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
- enddo
-
+ Evan1cat=epscalc*(r012/(rcal**6))
+ Evan2cat=epscalc*2*(r06/(rcal**3))
+ Eeleccat=k0/ract
+ r7 = rcal**7
+ r4 = rcal**4
+ r(1)=xj
+ r(2)=yj
+ r(3)=zj
+ do k=1,3
+ dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
+ dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
+ dEeleccat(k)=-k0*r(k)/ract**3
+ enddo
+ do k=1,3
+ gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
+ gradcatcat(k,i)=gradcatcat(k,i)-(gg(k)*sss2min2+(Evan1cat+Evan2cat+Eeleccat)*sss2mingrad2)
+ gradcatcat(k,j)=gradcatcat(k,j)+gg(k)*sss2min2+(Evan1cat+Evan2cat+Eeleccat)*sss2mingrad2
+ enddo
+ if (energy_dec) write (iout,*) "ecatcat",i,j,Evan1cat,Evan2cat,Eeleccat,&
+ r012,rcal**6,ichargecat(itypi)*ichargecat(itypj)
! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
- ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
- 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
!---------------------------------------------------------------------------
!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
+ real(kind=8) :: evdw,aa,bb
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip,alpha_sco
- integer :: ii
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
+ integer :: ii,ki
real(kind=8) :: fracinbuf
real (kind=8) :: escpho
real (kind=8),dimension(4):: ener
real(kind=8) :: facd4, adler, Fgb, facd3
integer troll,jj,istate
real (kind=8) :: dcosom1(3),dcosom2(3)
+ real(kind=8) ::locbox(3)
+ locbox(1)=boxxsize
+ locbox(2)=boxysize
+ locbox(3)=boxzsize
evdw=0.0D0
if (nres_molec(5).eq.0) return
eps_out=80.0d0
! sss_ele_cut=1.0d0
- itmp=0
- do i=1,4
- itmp=itmp+nres_molec(i)
- enddo
- go to 17
+ 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 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))
+ 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)
- xi=dmod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=dmod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=dmod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
- dsci_inv=vbld_inv(i+nres)
- do j=itmp+1,itmp+nres_molec(5)
+ if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle
+ itypi1=iabs(itype(i+1,1))
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
+ dsci_inv=vbld_inv(i+nres)
+! do j=itmp+1,itmp+nres_molec(5)
! Calculate SC interaction energy.
- itypj=iabs(itype(j,5))
- if ((itypj.eq.ntyp1)) cycle
- CALL elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
-
- dscj_inv=0.0
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
-
+ itypj=iabs(itype(j,5))
+ if ((itypj.eq.ntyp1)) cycle
+ CALL elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+
+ dscj_inv=0.0
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+
+ call to_box(xj,yj,zj)
+! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj
+
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+! write(iout,*) "xj,yj,zj", xj,yj,zj,boxxsize
+
+ dxj=0.0
+ dyj=0.0
+ dzj=0.0
! dxj = dc_norm( 1, nres+j )
! dyj = dc_norm( 2, nres+j )
! dzj = dc_norm( 3, nres+j )
- itypi = itype(i,1)
- itypj = itype(j,5)
+ itypi = itype(i,1)
+ itypj = itype(j,5)
! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
! sampling performed with amber package
! alf1 = 0.0d0
! alf2 = 0.0d0
! alf12 = 0.0d0
! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
- chi1 = chicat(itypi,itypj)
- chis1 = chiscat(itypi,itypj)
- chip1 = chippcat(itypi,itypj)
+ chi1 = chi1cat(itypi,itypj)
+ chis1 = chis1cat(itypi,itypj)
+ chip1 = chipp1cat(itypi,itypj)
! chi1=0.0d0
! chis1=0.0d0
! chip1=0.0d0
- chi2=0.0
- chip2=0.0
- chis2=0.0
+ chi2=0.0
+ chip2=0.0
+ chis2=0.0
! chis2 = chis(itypj,itypi)
- chis12 = chis1 * chis2
- sig1 = sigmap1cat(itypi,itypj)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1cat(itypi,itypj)
+ sig2=0.0d0
! sig2 = sigmap2(itypi,itypj)
! alpha factors from Fcav/Gcav
- b1cav = alphasurcat(1,itypi,itypj)
- b2cav = alphasurcat(2,itypi,itypj)
- b3cav = alphasurcat(3,itypi,itypj)
- b4cav = alphasurcat(4,itypi,itypj)
-
+ b1cav = alphasurcat(1,itypi,itypj)
+ b2cav = alphasurcat(2,itypi,itypj)
+ b3cav = alphasurcat(3,itypi,itypj)
+ b4cav = alphasurcat(4,itypi,itypj)
+
+! b1cav=0.0d0
+! b2cav=0.0d0
+! b3cav=0.0d0
+! b4cav=0.0d0
+
! used to determine whether we want to do quadrupole calculations
eps_in = epsintabcat(itypi,itypj)
if (eps_in.eq.0.0) eps_in=1.0
! Rtail = 0.0d0
DO k = 1, 3
- ctail(k,1)=c(k,i+nres)
- ctail(k,2)=c(k,j)
+ ctail(k,1)=c(k,i+nres)
+ ctail(k,2)=c(k,j)
END DO
+ call to_box(ctail(1,1),ctail(2,1),ctail(3,1))
+ call to_box(ctail(1,2),ctail(2,2),ctail(3,2))
!c! tail distances will be themselves usefull elswhere
!c1 (in Gcav, for example)
- Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
- Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
- Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
+ do k=1,3
+ Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k))
+ enddo
Rtail = dsqrt( &
- (Rtail_distance(1)*Rtail_distance(1)) &
- + (Rtail_distance(2)*Rtail_distance(2)) &
- + (Rtail_distance(3)*Rtail_distance(3)))
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
! tail location and distance calculations
! dhead1
d1 = dheadcat(1, 1, itypi, itypj)
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
- chead(k,2) = c(k, j)
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j)
+ enddo
+ call to_box(chead(1,1),chead(2,1),chead(3,1))
+ call to_box(chead(1,2),chead(2,2),chead(3,2))
+! write(iout,*) "TEST",chead(1,1),chead(2,1),chead(3,1),dc_norm(k, i+nres),d1
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
-! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
+ do k=1,3
+ Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k))
END DO
! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!-------------------------------------------------------------------
! zero everything that should be zero'ed
evdwij = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
+ Fcav = 0.0d0
+ Fisocav=0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
! print *,i,j,dscj_inv,dsci_inv
! rij holds 1/(distance of Calpha atoms)
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
- CALL sc_angular
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
+! print *,sss_ele_cut,sss_ele_grad,&
+! 1.0d0/(rij),r_cut_ele,rlamb_ele
+ if (sss_ele_cut.le.0.0) cycle
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = Rtail - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_aq_cat(itypi,itypj)
+ rij_shift = Rtail - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ if (evdw.gt.1.0d6) then
+ write (*,'(2(1x,a3,i3),7f7.2)') &
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij,sigsq
+ write(*,*) facsig,faceps1_inv,om1,chiom1,chi1
+ write(*,*) "ANISO?!",chi1
+!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+ endif
+
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_aq_cat(itypi,itypj)
! print *,"ADAM",aa_aq(itypi,itypj)
! c1 = 0.0d0
- c2 = fac * bb_aq_cat(itypi,itypj)
+ c2 = fac * bb_aq_cat(itypi,itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
+ evdwij = eps2rt * eps3rt * evdwij
!#ifdef TSCSC
! IF (bb_aq(itypi,itypj).gt.0) THEN
! evdw_p = evdw_p + evdwij
! evdw_m = evdw_m + evdwij
! END IF
!#else
- evdw = evdw &
- + evdwij
+ evdw = evdw &
+ + evdwij*sss_ele_cut
!#endif
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ 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
- 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
+ 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 )
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow*sss_ele_cut+&
+ Fcav*sss_ele_grad
+ Fcav=Fcav*sss_ele_cut
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
DO k= 1, 3
- ertail(k) = Rtail_distance(k)/Rtail
+ ertail(k) = Rtail_distance(k)/Rtail
END DO
erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
erdxj = scalar( ertail(1), dC_norm(1,j) )
facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
- facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j+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)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - (( dFdR + gg(k) ) * pom)
+ pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j))
! gvdwx(k,j) = gvdwx(k,j) &
! + (( dFdR + gg(k) ) * pom)
- gradpepcat(k,i) = gradpepcat(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
- gradpepcat(k,j) = gradpepcat(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
- gg(k) = 0.0d0
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
+ gg(k) = 0.0d0
ENDDO
!c! Compute head-head and head-tail energies for each state
- isel = iabs(Qi) + 1 ! ion is always charged so iabs(Qj)
- IF (isel.eq.0) THEN
-!c! No charges - do nothing
- eheadtail = 0.0d0
-
- ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
-!c! Nonpolar-charge interactions
- if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
- Qi=Qi*2
- Qij=Qij*2
- endif
- if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
- Qj=Qj*2
- Qij=Qij*2
- endif
-
- CALL enq_cat(epol)
- eheadtail = epol
-! eheadtail = 0.0d0
-
- ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
-!c! Dipole-charge interactions
- if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
- Qi=Qi*2
- Qij=Qij*2
- endif
- if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
- Qj=Qj*2
- Qij=Qij*2
- endif
- CALL edq_cat(ecl, elj, epol)
- eheadtail = ECL + elj + epol
-! eheadtail = 0.0d0
-
- ELSE IF ((isel.eq.2.and. &
- iabs(Qi).eq.1).and. &
- nstatecat(itypi,itypj).eq.1) THEN
-
-!c! Same charge-charge interaction ( +/+ or -/- )
- if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
- Qi=Qi*2
- Qij=Qij*2
- endif
- if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
- Qj=Qj*2
- Qij=Qij*2
- endif
-
- 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
- evdw = evdw + Fcav + eheadtail
+!! if (.false.) then ! turn off electrostatic
+ if (itype(j,5).gt.0) then ! the normal cation case
+ isel = iabs(Qi) + 1 ! ion is always charged so iabs(Qj)
+! print *,i,itype(i,1),isel
+ IF (isel.eq.0) THEN
+ eheadtail = 0.0d0
+ ELSE IF (isel.eq.1) THEN
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ CALL enq_cat(epol)
+ eheadtail = epol
+ ELSE IF (isel.eq.3) THEN
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ CALL edq_cat(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
+ ELSE IF ((isel.eq.2)) THEN
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ CALL eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
+ eheadtail = ECL + Egb + Epol + Fisocav + Elj
+ END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
+ else ! here is water and other molecules
+ isel = iabs(Qi)+2
+! isel=2
+! if (isel.eq.4) isel=2
+ if (isel.eq.2) then
+ eheadtail = 0.0d0
+ else if (isel.eq.3) then
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ call eqd_cat(ecl,elj,epol)
+ eheadtail = ECL + elj + epol
+ else if (isel.eq.4) then
+ call edd_cat(ecl)
+ eheadtail = ECL
+ endif
+! write(iout,*) "not yet implemented",j,itype(j,5)
+ endif
+!! endif ! turn off electrostatic
+ evdw = evdw + Fcav + eheadtail
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
- restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
- 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
- Equad,evdwij+Fcav+eheadtail,evdw
+ 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
+ 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 ! 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
- 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
+ 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
- xi=dmod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=dmod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=dmod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- dxi=dc_norm(1,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)
+ if ((itype(i,1).eq.ntyp1).or.itype(i+1,1).eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1,1))
+ xi=(c(1,i)+c(1,i+1))/2.0
+ yi=(c(2,i)+c(2,i+1))/2.0
+ zi=(c(3,i)+c(3,i+1))/2.0
+ call to_box(xi,yi,zi)
+ dxi=dc_norm(1,i)
+ dyi=dc_norm(2,i)
+ dzi=dc_norm(3,i)
+ dsci_inv=vbld_inv(i+1)/2.0
+! do j=itmp+1,itmp+nres_molec(5)
! Calculate SC interaction energy.
- itypj=iabs(itype(j,5))
- if ((itypj.eq.ntyp1)) cycle
- CALL elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
-
- dscj_inv=0.0
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
-
- dxj = 0.0d0! dc_norm( 1, nres+j )
- dyj = 0.0d0!dc_norm( 2, nres+j )
- dzj = 0.0d0! dc_norm( 3, nres+j )
-
- itypi = 10
- itypj = itype(j,5)
+ itypj=iabs(itype(j,5))
+ if ((itypj.eq.ntyp1)) cycle
+ CALL elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+
+ dscj_inv=0.0
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+
+ dxj = 0.0d0! dc_norm( 1, nres+j )
+ dyj = 0.0d0!dc_norm( 2, nres+j )
+ dzj = 0.0d0! dc_norm( 3, nres+j )
+
+ itypi = 10
+ itypj = itype(j,5)
! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
! sampling performed with amber package
! alf1 = 0.0d0
! alf2 = 0.0d0
! alf12 = 0.0d0
! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
- chi1 = chicat(itypi,itypj)
- chis1 = chiscat(itypi,itypj)
- chip1 = chippcat(itypi,itypj)
+ chi1 = chi1cat(itypi,itypj)
+ chis1 = chis1cat(itypi,itypj)
+ chip1 = chipp1cat(itypi,itypj)
! chi1=0.0d0
! chis1=0.0d0
! chip1=0.0d0
- chi2=0.0
- chip2=0.0
- chis2=0.0
+ chi2=0.0
+ chip2=0.0
+ chis2=0.0
! chis2 = chis(itypj,itypi)
- chis12 = chis1 * chis2
- sig1 = sigmap1cat(itypi,itypj)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1cat(itypi,itypj)
+ sig2=0.0
! sig2 = sigmap2(itypi,itypj)
! alpha factors from Fcav/Gcav
- b1cav = alphasurcat(1,itypi,itypj)
- b2cav = alphasurcat(2,itypi,itypj)
- b3cav = alphasurcat(3,itypi,itypj)
- b4cav = alphasurcat(4,itypi,itypj)
-
+ b1cav = alphasurcat(1,itypi,itypj)
+ b2cav = alphasurcat(2,itypi,itypj)
+ b3cav = alphasurcat(3,itypi,itypj)
+ b4cav = alphasurcat(4,itypi,itypj)
+
! used to determine whether we want to do quadrupole calculations
eps_in = epsintabcat(itypi,itypj)
if (eps_in.eq.0.0) eps_in=1.0
! 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)
+ 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_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)))
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
! tail location and distance calculations
! dhead1
d1 = dheadcat(1, 1, itypi, itypj)
+! print *,"d1",d1
+! d1=0.0d0
! d2 = dhead(2, 1, itypi, itypj)
DO k = 1,3
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
- chead(k,2) = c(k, j)
+ 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)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ 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)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!-------------------------------------------------------------------
! zero everything that should be zero'ed
evdwij = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = 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)
- CALL sc_angular
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ sss_ele_cut=sscale_ele(1.0d0/(rij))
+ sss_ele_grad=sscagrad_ele(1.0d0/(rij))
+! print *,sss_ele_cut,sss_ele_grad,&
+! 1.0d0/(rij),r_cut_ele,rlamb_ele
+ if (sss_ele_cut.le.0.0) cycle
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ 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)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = Rtail - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_aq_cat(itypi,itypj)
+ rij_shift = Rtail - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),6f6.2)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij
+!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_aq_cat(itypi,itypj)
! print *,"ADAM",aa_aq(itypi,itypj)
! c1 = 0.0d0
- c2 = fac * bb_aq_cat(itypi,itypj)
+ c2 = fac * bb_aq_cat(itypi,itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
+ evdwij = eps2rt * eps3rt * evdwij
!#ifdef TSCSC
! IF (bb_aq(itypi,itypj).gt.0) THEN
! evdw_p = evdw_p + evdwij
! evdw_m = evdw_m + evdwij
! END IF
!#else
- evdw = evdw &
- + evdwij
+ evdw = evdw &
+ + evdwij*sss_ele_cut
!#endif
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ 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
-
- 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
+ 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 )
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow*sss_ele_cut+&
+ Fcav*sss_ele_grad
+ Fcav=Fcav*sss_ele_cut
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+! dCAVdOM2 = dFdL * ( dFdOM2 )
+! dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM2=0.0d0
+ dCAVdOM12=0.0d0
DO k= 1, 3
- ertail(k) = Rtail_distance(k)/Rtail
+ ertail(k) = Rtail_distance(k)/Rtail
END DO
erdxi = scalar( ertail(1), dC_norm(1,i) )
erdxj = scalar( ertail(1), dC_norm(1,j) )
facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i)
facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j+nres)
DO k = 1, 3
- pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i))
+ pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i))
! gradpepcatx(k,i) = gradpepcatx(k,i) &
! - (( dFdR + gg(k) ) * pom)
- pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
+ pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
! gvdwx(k,j) = gvdwx(k,j) &
! + (( dFdR + gg(k) ) * pom)
- gradpepcat(k,i) = gradpepcat(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))/2.0d0
- gradpepcat(k,i+1) = gradpepcat(k,i+1) &
- - (( dFdR + gg(k) ) * ertail(k))/2.0d0
-
- gradpepcat(k,j) = gradpepcat(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
- gg(k) = 0.0d0
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))/2.0d0
+ gradpepcat(k,i+1) = gradpepcat(k,i+1) &
+ - (( dFdR + gg(k) ) * ertail(k))/2.0d0
+
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
+ gg(k) = 0.0d0
ENDDO
+ if (itype(j,5).gt.0) then
!c! Compute head-head and head-tail energies for each state
- isel = 3
+ 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
+ CALL edq_cat_pep(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
! print *,"i,",i,eheadtail
- eheadtail = 0.0d0
-
- evdw = evdw + Fcav + eheadtail
-
+! eheadtail = 0.0d0
+ else
+!HERE WATER and other types of molecules solvents will be added
+! write(iout,*) "not yet implemented"
+ CALL edd_cat_pep(ecl)
+ eheadtail=ecl
+! CALL edd_cat_pep
+! eheadtail=0.0d0
+ endif
+ evdw = evdw + Fcav + eheadtail
+! if (evdw.gt.1.0d6) then
+! write (*,'(2(1x,a3,i3),3f6.2,10f16.7)') &
+! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+! 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+! Equad,evdwij+Fcav+eheadtail,evdw
+! endif
IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
- restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
- 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
- Equad,evdwij+Fcav+eheadtail,evdw
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+ Equad,evdwij+Fcav+eheadtail,evdw
! evdw = evdw + Fcav + eheadtail
! iF (nstate(itypi,itypj).eq.1) THEN
- CALL sc_grad_cat_pep
+ CALL sc_grad_cat_pep
! END IF
!c!-------------------------------------------------------------------
!c! NAPISY KONCOWE
- END DO ! j
- END DO ! i
+ END DO ! j
+! END DO ! i
!c write (iout,*) "Number of loop steps in EGB:",ind
!c energy_dec=.false.
! print *,"EVDW KURW",evdw,nres
-
+ 23 continue
+! print *,"before leave sc_grad_cat", i,j, gradpepcat(1,nres-1)
return
end subroutine ecats_prot_amber
! use calc_data
! use comm_momo
integer i,j,k,subchap,itmp,inum
- real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
- r7,r4,ecationcation
- real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
- dist_init,dist_temp,ecation_prot,rcal,rocal, &
- Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
- catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
- wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
- costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
- Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
- rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
- opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
- opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
- Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip,&
- ndiv,ndivi
- real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
- gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
- dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
- tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
- v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
- dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
- dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
- dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
- dEvan1Cat
- real(kind=8),dimension(6) :: vcatprm
- ecation_prot=0.0d0
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
+ r7,r4
+ real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
+ dist_init,dist_temp,ecation_prot,rcal,rocal, &
+ Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
+ catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
+ wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
+ costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
+ Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
+ rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
+ opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
+ opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
+ Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip,&
+ ndiv,ndivi
+ real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
+ gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
+ dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
+ tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
+ v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
+ dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
+ dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
+ dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
+ dEvan1Cat
+ real(kind=8),dimension(6) :: vcatprm
+ ecation_prot=0.0d0
! first lets calculate interaction with peptide groups
- if (nres_molec(5).eq.0) return
- itmp=0
- do i=1,4
- itmp=itmp+nres_molec(i)
- enddo
+ if (nres_molec(5).eq.0) return
+ itmp=0
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
- do i=ibond_start,ibond_end
+ do i=ibond_start,ibond_end
! cycle
- if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
- xi=0.5d0*(c(1,i)+c(1,i+1))
- yi=0.5d0*(c(2,i)+c(2,i+1))
- zi=0.5d0*(c(3,i)+c(3,i+1))
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- do j=itmp+1,itmp+nres_molec(5)
+
+ if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
+ xi=0.5d0*(c(1,i)+c(1,i+1))
+ yi=0.5d0*(c(2,i)+c(2,i+1))
+ zi=0.5d0*(c(3,i)+c(3,i+1))
+ call to_box(xi,yi,zi)
+
+ do j=itmp+1,itmp+nres_molec(5)
! print *,"WTF",itmp,j,i
! all parameters were for Ca2+ to approximate single charge divide by two
- ndiv=1.0
- if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
- wconst=78*ndiv
- wdip =1.092777950857032D2
- wdip=wdip/wconst
- wmodquad=-2.174122713004870D4
- wmodquad=wmodquad/wconst
- wquad1 = 3.901232068562804D1
- wquad1=wquad1/wconst
- wquad2 = 3
- wquad2=wquad2/wconst
- wvan1 = 0.1
- wvan2 = 6
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
+ wconst=78*ndiv
+ wdip =1.092777950857032D2
+ wdip=wdip/wconst
+ wmodquad=-2.174122713004870D4
+ wmodquad=wmodquad/wconst
+ wquad1 = 3.901232068562804D1
+ wquad1=wquad1/wconst
+ wquad2 = 3
+ wquad2=wquad2/wconst
+ wvan1 = 0.1
+ wvan2 = 6
! itmp=0
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
! enddo
! enddo
rcpm = sqrt(xj**2+yj**2+zj**2)
enddo
dcmag=dsqrt(dcmag)
do k=1,3
- myd_norm(k)=dc(k,i)/dcmag
+ myd_norm(k)=dc(k,i)/dcmag
enddo
- costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
- drcp_norm(3)*myd_norm(3)
- rsecp = rcpm**2
- Ir = 1.0d0/rcpm
- Irsecp = 1.0d0/rsecp
- Irthrp = Irsecp/rcpm
- Irfourp = Irthrp/rcpm
- Irfiftp = Irfourp/rcpm
- Irsistp=Irfiftp/rcpm
- Irseven=Irsistp/rcpm
- Irtwelv=Irsistp*Irsistp
- Irthir=Irtwelv/rcpm
- sin2thet = (1-costhet*costhet)
- sinthet=sqrt(sin2thet)
- E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
- *sin2thet
- E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
- 2*wvan2**6*Irsistp)
- ecation_prot = ecation_prot+E1+E2
+ costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
+ drcp_norm(3)*myd_norm(3)
+ rsecp = rcpm**2
+ Ir = 1.0d0/rcpm
+ Irsecp = 1.0d0/rsecp
+ Irthrp = Irsecp/rcpm
+ Irfourp = Irthrp/rcpm
+ Irfiftp = Irfourp/rcpm
+ Irsistp=Irfiftp/rcpm
+ Irseven=Irsistp/rcpm
+ Irtwelv=Irsistp*Irsistp
+ Irthir=Irtwelv/rcpm
+ sin2thet = (1-costhet*costhet)
+ sinthet=sqrt(sin2thet)
+ E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
+ *sin2thet
+ E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
+ 2*wvan2**6*Irsistp)
+ ecation_prot = ecation_prot+E1+E2
! print *,"ecatprot",i,j,ecation_prot,rcpm
- dE1dr = -2*costhet*wdip*Irthrp-&
- (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
- dE2dr = 3*wquad1*wquad2*Irfourp- &
- 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
- dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
- do k=1,3
- drdpep(k) = -drcp_norm(k)
- dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
- dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
- dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
- dEddci(k) = dEdcos*dcosddci(k)
- enddo
- do k=1,3
- gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
- gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
- gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
- enddo
+ dE1dr = -2*costhet*wdip*Irthrp-&
+ (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
+ dE2dr = 3*wquad1*wquad2*Irfourp- &
+ 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
+ dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
+ do k=1,3
+ drdpep(k) = -drcp_norm(k)
+ dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
+ dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
+ dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
+ dEddci(k) = dEdcos*dcosddci(k)
+ enddo
+ do k=1,3
+ gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
+ gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
+ gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
+ enddo
enddo ! j
enddo ! i
!------------------------------------------sidechains
! do i=1,nres_molec(1)
- do i=ibond_start,ibond_end
- if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
+ do i=ibond_start,ibond_end
+ if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
! cycle
! print *,i,ecation_prot
- xi=(c(1,i+nres))
- yi=(c(2,i+nres))
- zi=(c(3,i+nres))
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- do k=1,3
- cm1(k)=dc(k,i+nres)
- enddo
- cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
- do j=itmp+1,itmp+nres_molec(5)
- ndiv=1.0
- if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
-
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
+ xi=(c(1,i+nres))
+ yi=(c(2,i+nres))
+ zi=(c(3,i+nres))
+ call to_box(xi,yi,zi)
+ do k=1,3
+ cm1(k)=dc(k,i+nres)
+ enddo
+ cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
+ do j=itmp+1,itmp+nres_molec(5)
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
+
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
! enddo
! enddo
! 15- Glu 16-Asp
- if((itype(i,1).eq.15.or.itype(i,1).eq.16).or.&
- ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.&
- (itype(i,1).eq.25))) then
- if(itype(i,1).eq.16) then
- inum=1
- else
- inum=2
- endif
- do k=1,6
- vcatprm(k)=catprm(k,inum)
- enddo
- dASGL=catprm(7,inum)
+ if((itype(i,1).eq.15.or.itype(i,1).eq.16).or.&
+ ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.&
+ (itype(i,1).eq.25))) then
+ if(itype(i,1).eq.16) then
+ inum=1
+ else
+ inum=2
+ endif
+ do k=1,6
+ vcatprm(k)=catprm(k,inum)
+ enddo
+ dASGL=catprm(7,inum)
! do k=1,3
! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
- vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
- vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
- vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
+ vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
+ vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
+ vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
! valpha(k)=c(k,i)
! vcat(k)=c(k,j)
- if (subchap.eq.1) then
- vcat(1)=xj_temp
- vcat(2)=yj_temp
- vcat(3)=zj_temp
- else
- vcat(1)=xj_safe
- vcat(2)=yj_safe
- vcat(3)=zj_safe
- endif
- valpha(1)=xi-c(1,i+nres)+c(1,i)
- valpha(2)=yi-c(2,i+nres)+c(2,i)
- valpha(3)=zi-c(3,i+nres)+c(3,i)
+ if (subchap.eq.1) then
+ vcat(1)=xj_temp
+ vcat(2)=yj_temp
+ vcat(3)=zj_temp
+ else
+ vcat(1)=xj_safe
+ vcat(2)=yj_safe
+ vcat(3)=zj_safe
+ endif
+ valpha(1)=xi-c(1,i+nres)+c(1,i)
+ valpha(2)=yi-c(2,i+nres)+c(2,i)
+ valpha(3)=zi-c(3,i+nres)+c(3,i)
! enddo
- do k=1,3
- dx(k) = vcat(k)-vcm(k)
- enddo
- do k=1,3
- v1(k)=(vcm(k)-valpha(k))
- v2(k)=(vcat(k)-valpha(k))
- enddo
- v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
- v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
- v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
+ do k=1,3
+ dx(k) = vcat(k)-vcm(k)
+ enddo
+ do k=1,3
+ v1(k)=(vcm(k)-valpha(k))
+ v2(k)=(vcat(k)-valpha(k))
+ enddo
+ v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
+ v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
+ v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
! The weights of the energy function calculated from
!The quantum mechanical GAMESS simulations of calcium with ASP/GLU
- if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
- ndivi=0.5
- else
- ndivi=1.0
- endif
- ndiv=1.0
- if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
-
- wh2o=78*ndivi*ndiv
- wc = vcatprm(1)
- wc=wc/wh2o
- wdip =vcatprm(2)
- wdip=wdip/wh2o
- wquad1 =vcatprm(3)
- wquad1=wquad1/wh2o
- wquad2 = vcatprm(4)
- wquad2=wquad2/wh2o
- wquad2p = 1.0d0-wquad2
- wvan1 = vcatprm(5)
- wvan2 =vcatprm(6)
- opt = dx(1)**2+dx(2)**2
- rsecp = opt+dx(3)**2
- rs = sqrt(rsecp)
- rthrp = rsecp*rs
- rfourp = rthrp*rs
- rsixp = rfourp*rsecp
- reight=rsixp*rsecp
- Ir = 1.0d0/rs
- Irsecp = 1.0d0/rsecp
- Irthrp = Irsecp/rs
- Irfourp = Irthrp/rs
- Irsixp = 1.0d0/rsixp
- Ireight=1.0d0/reight
- Irtw=Irsixp*Irsixp
- Irthir=Irtw/rs
- Irfourt=Irthir/rs
- opt1 = (4*rs*dx(3)*wdip)
- opt2 = 6*rsecp*wquad1*opt
- opt3 = wquad1*wquad2p*Irsixp
- opt4 = (wvan1*wvan2**12)
- opt5 = opt4*12*Irfourt
- opt6 = 2*wvan1*wvan2**6
- opt7 = 6*opt6*Ireight
- opt8 = wdip/v1m
- opt10 = wdip/v2m
- opt11 = (rsecp*v2m)**2
- opt12 = (rsecp*v1m)**2
- opt14 = (v1m*v2m*rsecp)**2
- opt15 = -wquad1/v2m**2
- opt16 = (rthrp*(v1m*v2m)**2)**2
- opt17 = (v1m**2*rthrp)**2
- opt18 = -wquad1/rthrp
- opt19 = (v1m**2*v2m**2)**2
- Ec = wc*Ir
- do k=1,3
- dEcCat(k) = -(dx(k)*wc)*Irthrp
- dEcCm(k)=(dx(k)*wc)*Irthrp
- dEcCalp(k)=0.0d0
- enddo
- Edip=opt8*(v1dpv2)/(rsecp*v2m)
- do k=1,3
- dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
- *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
- dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
- *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
- dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
- *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
- *v1dpv2)/opt14
- enddo
- Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
- do k=1,3
- dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
- (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
- v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
- dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
- (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
- v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
- dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
- v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
- v1dpv2**2)/opt19
- enddo
- Equad2=wquad1*wquad2p*Irthrp
- do k=1,3
- dEquad2Cat(k)=-3*dx(k)*rs*opt3
- dEquad2Cm(k)=3*dx(k)*rs*opt3
- dEquad2Calp(k)=0.0d0
- enddo
- Evan1=opt4*Irtw
- do k=1,3
- dEvan1Cat(k)=-dx(k)*opt5
- dEvan1Cm(k)=dx(k)*opt5
- dEvan1Calp(k)=0.0d0
- enddo
- Evan2=-opt6*Irsixp
- do k=1,3
- dEvan2Cat(k)=dx(k)*opt7
- dEvan2Cm(k)=-dx(k)*opt7
- dEvan2Calp(k)=0.0d0
- enddo
- ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ ndivi=0.5
+ else
+ ndivi=1.0
+ endif
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
+
+ wh2o=78*ndivi*ndiv
+ wc = vcatprm(1)
+ wc=wc/wh2o
+ wdip =vcatprm(2)
+ wdip=wdip/wh2o
+ wquad1 =vcatprm(3)
+ wquad1=wquad1/wh2o
+ wquad2 = vcatprm(4)
+ wquad2=wquad2/wh2o
+ wquad2p = 1.0d0-wquad2
+ wvan1 = vcatprm(5)
+ wvan2 =vcatprm(6)
+ opt = dx(1)**2+dx(2)**2
+ rsecp = opt+dx(3)**2
+ rs = sqrt(rsecp)
+ rthrp = rsecp*rs
+ rfourp = rthrp*rs
+ rsixp = rfourp*rsecp
+ reight=rsixp*rsecp
+ Ir = 1.0d0/rs
+ Irsecp = 1.0d0/rsecp
+ Irthrp = Irsecp/rs
+ Irfourp = Irthrp/rs
+ Irsixp = 1.0d0/rsixp
+ Ireight=1.0d0/reight
+ Irtw=Irsixp*Irsixp
+ Irthir=Irtw/rs
+ Irfourt=Irthir/rs
+ opt1 = (4*rs*dx(3)*wdip)
+ opt2 = 6*rsecp*wquad1*opt
+ opt3 = wquad1*wquad2p*Irsixp
+ opt4 = (wvan1*wvan2**12)
+ opt5 = opt4*12*Irfourt
+ opt6 = 2*wvan1*wvan2**6
+ opt7 = 6*opt6*Ireight
+ opt8 = wdip/v1m
+ opt10 = wdip/v2m
+ opt11 = (rsecp*v2m)**2
+ opt12 = (rsecp*v1m)**2
+ opt14 = (v1m*v2m*rsecp)**2
+ opt15 = -wquad1/v2m**2
+ opt16 = (rthrp*(v1m*v2m)**2)**2
+ opt17 = (v1m**2*rthrp)**2
+ opt18 = -wquad1/rthrp
+ opt19 = (v1m**2*v2m**2)**2
+ Ec = wc*Ir
+ do k=1,3
+ dEcCat(k) = -(dx(k)*wc)*Irthrp
+ dEcCm(k)=(dx(k)*wc)*Irthrp
+ dEcCalp(k)=0.0d0
+ enddo
+ Edip=opt8*(v1dpv2)/(rsecp*v2m)
+ do k=1,3
+ dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
+ *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
+ dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
+ *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
+ dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
+ *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
+ *v1dpv2)/opt14
+ enddo
+ Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
+ do k=1,3
+ dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
+ (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
+ v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
+ dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
+ (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
+ v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
+ dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
+ v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
+ v1dpv2**2)/opt19
+ enddo
+ Equad2=wquad1*wquad2p*Irthrp
+ do k=1,3
+ dEquad2Cat(k)=-3*dx(k)*rs*opt3
+ dEquad2Cm(k)=3*dx(k)*rs*opt3
+ dEquad2Calp(k)=0.0d0
+ enddo
+ Evan1=opt4*Irtw
+ do k=1,3
+ dEvan1Cat(k)=-dx(k)*opt5
+ dEvan1Cm(k)=dx(k)*opt5
+ dEvan1Calp(k)=0.0d0
+ enddo
+ Evan2=-opt6*Irsixp
+ do k=1,3
+ dEvan2Cat(k)=dx(k)*opt7
+ dEvan2Cm(k)=-dx(k)*opt7
+ dEvan2Calp(k)=0.0d0
+ enddo
+ ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
-
- do k=1,3
- dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
- dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
+
+ do k=1,3
+ dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
+ dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
!c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
- dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
- dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
- dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
- +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
- enddo
- dscmag = 0.0d0
- do k=1,3
- dscvec(k) = dc(k,i+nres)
- dscmag = dscmag+dscvec(k)*dscvec(k)
- enddo
- dscmag3 = dscmag
- dscmag = sqrt(dscmag)
- dscmag3 = dscmag3*dscmag
- constA = 1.0d0+dASGL/dscmag
- constB = 0.0d0
- do k=1,3
- constB = constB+dscvec(k)*dEtotalCm(k)
- enddo
- constB = constB*dASGL/dscmag3
- do k=1,3
- gg(k) = dEtotalCm(k)+dEtotalCalp(k)
- gradpepcatx(k,i)=gradpepcatx(k,i)+ &
- constA*dEtotalCm(k)-constB*dscvec(k)
+ dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
+ dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
+ dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
+ +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
+ enddo
+ dscmag = 0.0d0
+ do k=1,3
+ dscvec(k) = dc(k,i+nres)
+ dscmag = dscmag+dscvec(k)*dscvec(k)
+ enddo
+ dscmag3 = dscmag
+ dscmag = sqrt(dscmag)
+ dscmag3 = dscmag3*dscmag
+ constA = 1.0d0+dASGL/dscmag
+ constB = 0.0d0
+ do k=1,3
+ constB = constB+dscvec(k)*dEtotalCm(k)
+ enddo
+ constB = constB*dASGL/dscmag3
+ do k=1,3
+ gg(k) = dEtotalCm(k)+dEtotalCalp(k)
+ gradpepcatx(k,i)=gradpepcatx(k,i)+ &
+ constA*dEtotalCm(k)-constB*dscvec(k)
! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
- gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
- gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
- enddo
- else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
- if(itype(i,1).eq.14) then
- inum=3
- else
- inum=4
- endif
- do k=1,6
- vcatprm(k)=catprm(k,inum)
- enddo
- dASGL=catprm(7,inum)
+ gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
+ gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
+ enddo
+ else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
+ if(itype(i,1).eq.14) then
+ inum=3
+ else
+ inum=4
+ endif
+ do k=1,6
+ vcatprm(k)=catprm(k,inum)
+ enddo
+ dASGL=catprm(7,inum)
! do k=1,3
! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
! valpha(k)=c(k,i)
! vcat(k)=c(k,j)
! enddo
- vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
- vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
- vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
- if (subchap.eq.1) then
- vcat(1)=xj_temp
- vcat(2)=yj_temp
- vcat(3)=zj_temp
- else
- vcat(1)=xj_safe
- vcat(2)=yj_safe
- vcat(3)=zj_safe
- endif
- valpha(1)=xi-c(1,i+nres)+c(1,i)
- valpha(2)=yi-c(2,i+nres)+c(2,i)
- valpha(3)=zi-c(3,i+nres)+c(3,i)
+ vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
+ vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
+ vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
+ if (subchap.eq.1) then
+ vcat(1)=xj_temp
+ vcat(2)=yj_temp
+ vcat(3)=zj_temp
+ else
+ vcat(1)=xj_safe
+ vcat(2)=yj_safe
+ vcat(3)=zj_safe
+ endif
+ valpha(1)=xi-c(1,i+nres)+c(1,i)
+ valpha(2)=yi-c(2,i+nres)+c(2,i)
+ valpha(3)=zi-c(3,i+nres)+c(3,i)
- do k=1,3
- dx(k) = vcat(k)-vcm(k)
- enddo
- do k=1,3
- v1(k)=(vcm(k)-valpha(k))
- v2(k)=(vcat(k)-valpha(k))
- enddo
- v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
- v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
- v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
+ do k=1,3
+ dx(k) = vcat(k)-vcm(k)
+ enddo
+ do k=1,3
+ v1(k)=(vcm(k)-valpha(k))
+ v2(k)=(vcat(k)-valpha(k))
+ enddo
+ v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
+ v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
+ v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
! The weights of the energy function calculated from
!The quantum mechanical GAMESS simulations of ASN/GLN with calcium
- ndiv=1.0
- if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
-
- wh2o=78*ndiv
- wdip =vcatprm(2)
- wdip=wdip/wh2o
- wquad1 =vcatprm(3)
- wquad1=wquad1/wh2o
- wquad2 = vcatprm(4)
- wquad2=wquad2/wh2o
- wquad2p = 1-wquad2
- wvan1 = vcatprm(5)
- wvan2 =vcatprm(6)
- opt = dx(1)**2+dx(2)**2
- rsecp = opt+dx(3)**2
- rs = sqrt(rsecp)
- rthrp = rsecp*rs
- rfourp = rthrp*rs
- rsixp = rfourp*rsecp
- reight=rsixp*rsecp
- Ir = 1.0d0/rs
- Irsecp = 1/rsecp
- Irthrp = Irsecp/rs
- Irfourp = Irthrp/rs
- Irsixp = 1/rsixp
- Ireight=1/reight
- Irtw=Irsixp*Irsixp
- Irthir=Irtw/rs
- Irfourt=Irthir/rs
- opt1 = (4*rs*dx(3)*wdip)
- opt2 = 6*rsecp*wquad1*opt
- opt3 = wquad1*wquad2p*Irsixp
- opt4 = (wvan1*wvan2**12)
- opt5 = opt4*12*Irfourt
- opt6 = 2*wvan1*wvan2**6
- opt7 = 6*opt6*Ireight
- opt8 = wdip/v1m
- opt10 = wdip/v2m
- opt11 = (rsecp*v2m)**2
- opt12 = (rsecp*v1m)**2
- opt14 = (v1m*v2m*rsecp)**2
- opt15 = -wquad1/v2m**2
- opt16 = (rthrp*(v1m*v2m)**2)**2
- opt17 = (v1m**2*rthrp)**2
- opt18 = -wquad1/rthrp
- opt19 = (v1m**2*v2m**2)**2
- Edip=opt8*(v1dpv2)/(rsecp*v2m)
- do k=1,3
- dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
- *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
- dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
- *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
- dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
- *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
- *v1dpv2)/opt14
- enddo
- Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
- do k=1,3
- dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
- (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
- v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
- dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
- (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
- v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
- dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
- v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
- v1dpv2**2)/opt19
- enddo
- Equad2=wquad1*wquad2p*Irthrp
- do k=1,3
- dEquad2Cat(k)=-3*dx(k)*rs*opt3
- dEquad2Cm(k)=3*dx(k)*rs*opt3
- dEquad2Calp(k)=0.0d0
- enddo
- Evan1=opt4*Irtw
- do k=1,3
- dEvan1Cat(k)=-dx(k)*opt5
- dEvan1Cm(k)=dx(k)*opt5
- dEvan1Calp(k)=0.0d0
- enddo
- Evan2=-opt6*Irsixp
- do k=1,3
- dEvan2Cat(k)=dx(k)*opt7
- dEvan2Cm(k)=-dx(k)*opt7
- dEvan2Calp(k)=0.0d0
- enddo
- ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
- do k=1,3
- dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
- dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
- dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
- dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
- dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
- +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
- enddo
- dscmag = 0.0d0
- do k=1,3
- dscvec(k) = c(k,i+nres)-c(k,i)
+ ndiv=1.0
+ if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
+
+ wh2o=78*ndiv
+ wdip =vcatprm(2)
+ wdip=wdip/wh2o
+ wquad1 =vcatprm(3)
+ wquad1=wquad1/wh2o
+ wquad2 = vcatprm(4)
+ wquad2=wquad2/wh2o
+ wquad2p = 1-wquad2
+ wvan1 = vcatprm(5)
+ wvan2 =vcatprm(6)
+ opt = dx(1)**2+dx(2)**2
+ rsecp = opt+dx(3)**2
+ rs = sqrt(rsecp)
+ rthrp = rsecp*rs
+ rfourp = rthrp*rs
+ rsixp = rfourp*rsecp
+ reight=rsixp*rsecp
+ Ir = 1.0d0/rs
+ Irsecp = 1/rsecp
+ Irthrp = Irsecp/rs
+ Irfourp = Irthrp/rs
+ Irsixp = 1/rsixp
+ Ireight=1/reight
+ Irtw=Irsixp*Irsixp
+ Irthir=Irtw/rs
+ Irfourt=Irthir/rs
+ opt1 = (4*rs*dx(3)*wdip)
+ opt2 = 6*rsecp*wquad1*opt
+ opt3 = wquad1*wquad2p*Irsixp
+ opt4 = (wvan1*wvan2**12)
+ opt5 = opt4*12*Irfourt
+ opt6 = 2*wvan1*wvan2**6
+ opt7 = 6*opt6*Ireight
+ opt8 = wdip/v1m
+ opt10 = wdip/v2m
+ opt11 = (rsecp*v2m)**2
+ opt12 = (rsecp*v1m)**2
+ opt14 = (v1m*v2m*rsecp)**2
+ opt15 = -wquad1/v2m**2
+ opt16 = (rthrp*(v1m*v2m)**2)**2
+ opt17 = (v1m**2*rthrp)**2
+ opt18 = -wquad1/rthrp
+ opt19 = (v1m**2*v2m**2)**2
+ Edip=opt8*(v1dpv2)/(rsecp*v2m)
+ do k=1,3
+ dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
+ *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
+ dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
+ *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
+ dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
+ *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
+ *v1dpv2)/opt14
+ enddo
+ Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
+ do k=1,3
+ dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
+ (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
+ v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
+ dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
+ (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
+ v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
+ dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
+ v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
+ v1dpv2**2)/opt19
+ enddo
+ Equad2=wquad1*wquad2p*Irthrp
+ do k=1,3
+ dEquad2Cat(k)=-3*dx(k)*rs*opt3
+ dEquad2Cm(k)=3*dx(k)*rs*opt3
+ dEquad2Calp(k)=0.0d0
+ enddo
+ Evan1=opt4*Irtw
+ do k=1,3
+ dEvan1Cat(k)=-dx(k)*opt5
+ dEvan1Cm(k)=dx(k)*opt5
+ dEvan1Calp(k)=0.0d0
+ enddo
+ Evan2=-opt6*Irsixp
+ do k=1,3
+ dEvan2Cat(k)=dx(k)*opt7
+ dEvan2Cm(k)=-dx(k)*opt7
+ dEvan2Calp(k)=0.0d0
+ enddo
+ ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
+ do k=1,3
+ dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
+ dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
+ dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
+ dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
+ dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
+ +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
+ enddo
+ dscmag = 0.0d0
+ do k=1,3
+ dscvec(k) = c(k,i+nres)-c(k,i)
! TU SPRAWDZ???
! dscvec(1) = xj
! dscvec(2) = yj
! dscvec(3) = zj
- dscmag = dscmag+dscvec(k)*dscvec(k)
- enddo
- dscmag3 = dscmag
- dscmag = sqrt(dscmag)
- dscmag3 = dscmag3*dscmag
- constA = 1+dASGL/dscmag
- constB = 0.0d0
- do k=1,3
- constB = constB+dscvec(k)*dEtotalCm(k)
- enddo
- constB = constB*dASGL/dscmag3
- do k=1,3
- gg(k) = dEtotalCm(k)+dEtotalCalp(k)
- gradpepcatx(k,i)=gradpepcatx(k,i)+ &
- constA*dEtotalCm(k)-constB*dscvec(k)
- gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
- gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
- enddo
- else
- rcal = 0.0d0
- do k=1,3
+ dscmag = dscmag+dscvec(k)*dscvec(k)
+ enddo
+ dscmag3 = dscmag
+ dscmag = sqrt(dscmag)
+ dscmag3 = dscmag3*dscmag
+ constA = 1+dASGL/dscmag
+ constB = 0.0d0
+ do k=1,3
+ constB = constB+dscvec(k)*dEtotalCm(k)
+ enddo
+ constB = constB*dASGL/dscmag3
+ do k=1,3
+ gg(k) = dEtotalCm(k)+dEtotalCalp(k)
+ gradpepcatx(k,i)=gradpepcatx(k,i)+ &
+ constA*dEtotalCm(k)-constB*dscvec(k)
+ gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
+ gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
+ enddo
+ else
+ rcal = 0.0d0
+ do k=1,3
! r(k) = c(k,j)-c(k,i+nres)
- r(1) = xj
- r(2) = yj
- r(3) = zj
- rcal = rcal+r(k)*r(k)
- enddo
- ract=sqrt(rcal)
- rocal=1.5
- epscalc=0.2
- r0p=0.5*(rocal+sig0(itype(i,1)))
- r06 = r0p**6
- r012 = r06*r06
- Evan1=epscalc*(r012/rcal**6)
- Evan2=epscalc*2*(r06/rcal**3)
- r4 = rcal**4
- r7 = rcal**7
- do k=1,3
- dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
- dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
- enddo
- do k=1,3
- dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
- enddo
- ecation_prot = ecation_prot+ Evan1+Evan2
- do k=1,3
- gradpepcatx(k,i)=gradpepcatx(k,i)+ &
- dEtotalCm(k)
- gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
- gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
- enddo
- endif ! 13-16 residues
+ r(1) = xj
+ r(2) = yj
+ r(3) = zj
+ rcal = rcal+r(k)*r(k)
+ enddo
+ ract=sqrt(rcal)
+ rocal=1.5
+ epscalc=0.2
+ r0p=0.5*(rocal+sig0(itype(i,1)))
+ r06 = r0p**6
+ r012 = r06*r06
+ Evan1=epscalc*(r012/rcal**6)
+ Evan2=epscalc*2*(r06/rcal**3)
+ r4 = rcal**4
+ r7 = rcal**7
+ do k=1,3
+ dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
+ dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
+ enddo
+ do k=1,3
+ dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
+ enddo
+ ecation_prot = ecation_prot+ Evan1+Evan2
+ do k=1,3
+ gradpepcatx(k,i)=gradpepcatx(k,i)+ &
+ dEtotalCm(k)
+ gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
+ gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
+ enddo
+ endif ! 13-16 residues
enddo !j
enddo !i
return
end subroutine ecat_prot
!----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
- subroutine eprot_sc_base(escbase)
- use calc_data
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.LOCAL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DERIV'
-! include 'COMMON.NAMES'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CALC'
-! include 'COMMON.CONTROL'
-! include 'COMMON.SBRIDGE'
- logical :: lprn
-!el local variables
+!---------------------------------------------------------------------------
+ subroutine ecat_nucl(ecation_nucl)
+ integer i,j,k,subchap,itmp,inum,itypi,itypj
+ real(kind=8) :: xi,yi,zi,xj,yj,zj
+ real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
+ dist_init,dist_temp,ecation_nucl,Evan1,Evan2,Ecav,Egb,wdip1,wdip2, &
+ wvan1,wvan2,wgbsig,wgbeps,wgbchi,wgbchip,wcav1,wcav2,wcav3,wcav4, &
+ wcavsig,wcavchi,v1m,v1dpdx,wh2o,wc,Edip,rcs2,invrcs6,invrcs8,invrcs12, &
+ invrcs14,rcb,rcb2,invrcb,invrcb2,invrcb4,invrcb6,cosinus,cos2,dcosdcatconst, &
+ dcosdcalpconst,dcosdcmconst,rcav,rcav11,rcav12,constcav1,constcav2, &
+ constgb1,constgb2,constdvan1,constdvan2,sgb,sgb6,sgb7,sgb12,sgb13, &
+ cavnum,cavdenom,invcavdenom2,dcavnumdcos,dcavnumdr,dcavdenomdcos, &
+ dcavdenomdr,sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb
+ real(kind=8),dimension(3) ::gg,r,dEtotalCm,dEtotalCalp,dEvan1Cm,&
+ dEvan2Cm,cm1,cm,vcat,vsug,v1,v2,dx,vcm,dEdipCm,dEdipCalp, &
+ dEvan1Calp,dEvan2Cat,dEvan2Calp,dEtotalCat,dEdipCat,dEvan1Cat,dcosdcat, &
+ dcosdcalp,dcosdcm,dEgbdCat,dEgbdCalp,dEgbdCm,dEcavdCat,dEcavdCalp, &
+ dEcavdCm,boxik
+ real(kind=8),dimension(14) :: vcatnuclprm
+ ecation_nucl=0.0d0
+ boxik(1)=boxxsize
+ boxik(2)=boxysize
+ boxik(3)=boxzsize
+
+ if (nres_molec(5).eq.0) return
+ itmp=0
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
+! print *,nres_molec(2),"nres2"
+ do i=ibond_nucl_start,ibond_nucl_end
+! do i=iatsc_s_nucl,iatsc_e_nucl
+ if ((itype(i,2).eq.ntyp1_molec(2))) cycle ! leave dummy atoms
+ xi=(c(1,i+nres))
+ yi=(c(2,i+nres))
+ zi=(c(3,i+nres))
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do k=1,3
+ cm1(k)=dc(k,i+nres)
+ enddo
+ do j=itmp+1,itmp+nres_molec(5)
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+! print *,i,j,itmp
+! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+! write(iout,*) 'after shift', xj,yj,zj
+ dist_init=xj**2+yj**2+zj**2
+
+ itypi=itype(i,2)
+ itypj=itype(j,5)
+ do k=1,13
+ vcatnuclprm(k)=catnuclprm(k,itypi,itypj)
+ enddo
+ do k=1,3
+ vcm(k)=c(k,i+nres)
+ vsug(k)=c(k,i)
+ vcat(k)=c(k,j)
+ enddo
+ call to_box(vcm(1),vcm(2),vcm(3))
+ call to_box(vsug(1),vsug(2),vsug(3))
+ call to_box(vcat(1),vcat(2),vcat(3))
+ do k=1,3
+! dx(k) = vcat(k)-vcm(k)
+! enddo
+ dx(k)=boxshift(vcat(k)-vcm(k),boxik(k))
+! do k=1,3
+ v1(k)=dc(k,i+nres)
+ v2(k)=boxshift(vcat(k)-vsug(k),boxik(k))
+ enddo
+ v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
+ v1dpdx = v1(1)*dx(1)+v1(2)*dx(2)+v1(3)*dx(3)
+! The weights of the energy function calculated from
+!The quantum mechanical Gaussian simulations of potassium and sodium with deoxynucleosides
+ wh2o=78
+ wdip1 = vcatnuclprm(1)
+ wdip1 = wdip1/wh2o !w1
+ wdip2 = vcatnuclprm(2)
+ wdip2 = wdip2/wh2o !w2
+ wvan1 = vcatnuclprm(3)
+ wvan2 = vcatnuclprm(4) !pis1
+ wgbsig = vcatnuclprm(5) !sigma0
+ wgbeps = vcatnuclprm(6) !epsi0
+ wgbchi = vcatnuclprm(7) !chi1
+ wgbchip = vcatnuclprm(8) !chip1
+ wcavsig = vcatnuclprm(9) !sig
+ wcav1 = vcatnuclprm(10) !b1
+ wcav2 = vcatnuclprm(11) !b2
+ wcav3 = vcatnuclprm(12) !b3
+ wcav4 = vcatnuclprm(13) !b4
+ wcavchi = vcatnuclprm(14) !chis1
+ rcs2 = v2(1)**2+v2(2)**2+v2(3)**2
+ invrcs6 = 1/rcs2**3
+ invrcs8 = invrcs6/rcs2
+ invrcs12 = invrcs6**2
+ invrcs14 = invrcs12/rcs2
+ rcb2 = dx(1)**2+dx(2)**2+dx(3)**2
+ rcb = sqrt(rcb2)
+ invrcb = 1/rcb
+ invrcb2 = invrcb**2
+ invrcb4 = invrcb2**2
+ invrcb6 = invrcb4*invrcb2
+ cosinus = v1dpdx/(v1m*rcb)
+ cos2 = cosinus**2
+ dcosdcatconst = invrcb2/v1m
+ dcosdcalpconst = invrcb/v1m**2
+ dcosdcmconst = invrcb2/v1m**2
+ do k=1,3
+ dcosdcat(k) = (v1(k)*rcb-dx(k)*v1m*cosinus)*dcosdcatconst
+ dcosdcalp(k) = (v1(k)*rcb*cosinus-dx(k)*v1m)*dcosdcalpconst
+ dcosdcm(k) = ((dx(k)-v1(k))*v1m*rcb+ &
+ cosinus*(dx(k)*v1m**2-v1(k)*rcb2))*dcosdcmconst
+ enddo
+ rcav = rcb/wcavsig
+ rcav11 = rcav**11
+ rcav12 = rcav11*rcav
+ constcav1 = 1-wcavchi*cos2
+ constcav2 = sqrt(constcav1)
+ constgb1 = 1/sqrt(1-wgbchi*cos2)
+ constgb2 = wgbeps*(1-wgbchip*cos2)**2
+ constdvan1 = 12*wvan1*wvan2**12*invrcs14
+ constdvan2 = 6*wvan1*wvan2**6*invrcs8
+!----------------------------------------------------------------------------
+!Gay-Berne term
+!---------------------------------------------------------------------------
+ sgb = 1/(1-constgb1+(rcb/wgbsig))
+ sgb6 = sgb**6
+ sgb7 = sgb6*sgb
+ sgb12 = sgb6**2
+ sgb13 = sgb12*sgb
+ Egb = constgb2*(sgb12-sgb6)
+ do k=1,3
+ dEgbdCat(k) = -constgb2/wgbsig*(12*sgb13-6*sgb7)*invrcb*dx(k) &
+ +(constgb1**3*constgb2*wgbchi*cosinus*(12*sgb13-6*sgb7) &
+ -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcat(k)
+ dEgbdCm(k) = constgb2/wgbsig*(12*sgb13-6*sgb7)*invrcb*dx(k) &
+ +(constgb1**3*constgb2*wgbchi*cosinus*(12*sgb13-6*sgb7) &
+ -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcm(k)
+ dEgbdCalp(k) = (constgb1**3*constgb2*wgbchi*cosinus &
+ *(12*sgb13-6*sgb7) &
+ -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcalp(k)
+ enddo
+!----------------------------------------------------------------------------
+!cavity term
+!---------------------------------------------------------------------------
+ cavnum = sqrt(rcav*constcav2)+wcav2*rcav*constcav2-wcav3
+ cavdenom = 1+wcav4*rcav12*constcav1**6
+ Ecav = wcav1*cavnum/cavdenom
+ invcavdenom2 = 1/cavdenom**2
+ dcavnumdcos = -wcavchi*cosinus/constcav2 &
+ *(sqrt(rcav/constcav2)/2+wcav2*rcav)
+ dcavnumdr = (0.5*sqrt(constcav2/rcav)+wcav2*constcav2)/wcavsig
+ dcavdenomdcos = -12*wcav4*wcavchi*rcav12*constcav1**5*cosinus
+ dcavdenomdr = 12*wcav4/wcavsig*rcav11*constcav1**6
+ do k=1,3
+ dEcavdCat(k) = ((dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
+ *dcosdcat(k)+(dcavnumdr*cavdenom-dcavdenomdr*cavnum)/rcb*dx(k))*wcav1*invcavdenom2
+ dEcavdCm(k) = ((dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
+ *dcosdcm(k)-(dcavnumdr*cavdenom-dcavdenomdr*cavnum)/rcb*dx(k))*wcav1*invcavdenom2
+ dEcavdCalp(k) = (dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) &
+ *dcosdcalp(k)*wcav1*invcavdenom2
+ enddo
+!----------------------------------------------------------------------------
+!van der Waals and dipole-charge interaction energy
+!---------------------------------------------------------------------------
+ Evan1 = wvan1*wvan2**12*invrcs12
+ do k=1,3
+ dEvan1Cat(k) = -v2(k)*constdvan1
+ dEvan1Cm(k) = 0.0d0
+ dEvan1Calp(k) = v2(k)*constdvan1
+ enddo
+ Evan2 = -wvan1*wvan2**6*invrcs6
+ do k=1,3
+ dEvan2Cat(k) = v2(k)*constdvan2
+ dEvan2Cm(k) = 0.0d0
+ dEvan2Calp(k) = -v2(k)*constdvan2
+ enddo
+ Edip = wdip1*cosinus*invrcb2-wdip2*(1-cos2)*invrcb4
+ do k=1,3
+ dEdipCat(k) = (-2*wdip1*cosinus*invrcb4 &
+ +4*wdip2*(1-cos2)*invrcb6)*dx(k) &
+ +dcosdcat(k)*(wdip1*invrcb2+2*wdip2*cosinus*invrcb4)
+ dEdipCm(k) = (2*wdip1*cosinus*invrcb4 &
+ -4*wdip2*(1-cos2)*invrcb6)*dx(k) &
+ +dcosdcm(k)*(wdip1*invrcb2+2*wdip2*cosinus*invrcb4)
+ dEdipCalp(k) = dcosdcalp(k)*(wdip1*invrcb2 &
+ +2*wdip2*cosinus*invrcb4)
+ enddo
+ if (energy_dec) write (iout,'(2i5,4(a6,f7.3))') i,j, &
+ ' E GB ',Egb,' ECav ',Ecav,' Evdw ',Evan1+Evan2,' Edip ',Edip
+ ecation_nucl=ecation_nucl+Ecav+Egb+Edip+Evan1+Evan2
+ do k=1,3
+ dEtotalCat(k) = dEcavdCat(k)+dEvan1Cat(k)+dEvan2Cat(k) &
+ +dEgbdCat(k)+dEdipCat(k)
+ dEtotalCm(k) = dEcavdCm(k)+dEvan1Cm(k)+dEvan2Cm(k) &
+ +dEgbdCm(k)+dEdipCm(k)
+ dEtotalCalp(k) = dEcavdCalp(k)+dEgbdCalp(k)+dEvan1Calp(k) &
+ +dEdipCalp(k)+dEvan2Calp(k)
+ enddo
+ do k=1,3
+ gg(k) = dEtotalCm(k)+dEtotalCalp(k)
+ gradnuclcatx(k,i)=gradnuclcatx(k,i)+dEtotalCm(k)
+ gradnuclcat(k,i)=gradnuclcat(k,i)+gg(k)
+ gradnuclcat(k,j)=gradnuclcat(k,j)+dEtotalCat(k)
+ enddo
+ enddo !j
+ enddo !i
+ return
+ end subroutine ecat_nucl
+
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+ subroutine eprot_sc_base(escbase)
+ use calc_data
+! implicit real(kind=8) (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'COMMON.GEO'
+! include 'COMMON.VAR'
+! include 'COMMON.LOCAL'
+! include 'COMMON.CHAIN'
+! include 'COMMON.DERIV'
+! include 'COMMON.NAMES'
+! include 'COMMON.INTERACT'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CALC'
+! include 'COMMON.CONTROL'
+! include 'COMMON.SBRIDGE'
+ logical :: lprn
+!el local variables
integer :: iint,itypi,itypi1,itypj,subchap
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0ij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip
+ dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: escbase
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
+ sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
eps_out=80.0d0
escbase=0.0d0
! do i=1,nres_molec(1)
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1)) cycle
- itypi = itype(i,1)
- dxi = dc_norm(1,nres+i)
- dyi = dc_norm(2,nres+i)
- dzi = dc_norm(3,nres+i)
- dsci_inv = vbld_inv(i+nres)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
- itypj= itype(j,2)
- if (itype(j,2).eq.ntyp1_molec(2))cycle
- xj=c(1,j+nres)
- yj=c(2,j+nres)
- zj=c(3,j+nres)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- dxj = dc_norm( 1, nres+j )
- dyj = dc_norm( 2, nres+j )
- dzj = dc_norm( 3, nres+j )
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1)) cycle
+ itypi = itype(i,1)
+ dxi = dc_norm(1,nres+i)
+ dyi = dc_norm(2,nres+i)
+ dzi = dc_norm(3,nres+i)
+ dsci_inv = vbld_inv(i+nres)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
+ itypj= itype(j,2)
+ if (itype(j,2).eq.ntyp1_molec(2))cycle
+ xj=c(1,j+nres)
+ yj=c(2,j+nres)
+ zj=c(3,j+nres)
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
! print *,i,j,itypi,itypj
- d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
- d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
+ d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
+ d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
! d1i=0.0d0
! d1j=0.0d0
! BetaT = 1.0d0 / (298.0d0 * Rb)
! Gay-berne var's
- sig0ij = sigma_scbase( itypi,itypj )
- chi1 = chi_scbase( itypi, itypj,1 )
- chi2 = chi_scbase( itypi, itypj,2 )
+ sig0ij = sigma_scbase( itypi,itypj )
+ if (sig0ij.lt.0.2) print *,"KURWA",sig0ij,itypi,itypj
+ chi1 = chi_scbase( itypi, itypj,1 )
+ chi2 = chi_scbase( itypi, itypj,2 )
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
- chip1 = chipp_scbase( itypi, itypj,1 )
- chip2 = chipp_scbase( itypi, itypj,2 )
+ chi12 = chi1 * chi2
+ chip1 = chipp_scbase( itypi, itypj,1 )
+ chip2 = chipp_scbase( itypi, itypj,2 )
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
+ chip12 = chip1 * chip2
! not used by momo potential, but needed by sc_angular which is shared
! by all energy_potential subroutines
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
! a12sq = a12sq * a12sq
! charge of amino acid itypi is...
- chis1 = chis_scbase(itypi,itypj,1)
- chis2 = chis_scbase(itypi,itypj,2)
- chis12 = chis1 * chis2
- sig1 = sigmap1_scbase(itypi,itypj)
- sig2 = sigmap2_scbase(itypi,itypj)
+ chis1 = chis_scbase(itypi,itypj,1)
+ chis2 = chis_scbase(itypi,itypj,2)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_scbase(itypi,itypj)
+ sig2 = sigmap2_scbase(itypi,itypj)
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- b1 = alphasur_scbase(1,itypi,itypj)
+ b1 = alphasur_scbase(1,itypi,itypj)
! b1=0.0d0
- b2 = alphasur_scbase(2,itypi,itypj)
- b3 = alphasur_scbase(3,itypi,itypj)
- b4 = alphasur_scbase(4,itypi,itypj)
+ b2 = alphasur_scbase(2,itypi,itypj)
+ b3 = alphasur_scbase(3,itypi,itypj)
+ b4 = alphasur_scbase(4,itypi,itypj)
! used to determine whether we want to do quadrupole calculations
! used by Fgb
eps_in = epsintab_scbase(itypi,itypj)
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
+ chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!-------------------------------------------------------------------
! zero everything that should be zero'ed
evdwij = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
! print *,i,j,dscj_inv,dsci_inv
! rij holds 1/(distance of Calpha atoms)
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
!----------------------------
- CALL sc_angular
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = 1.0/rij - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_scbase(itypi,itypj)
+ rij_shift = 1.0/rij - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_scbase(itypi,itypj)
! c1 = 0.0d0
- c2 = fac * bb_scbase(itypi,itypj)
+ c2 = fac * bb_scbase(itypi,itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ evdwij = eps2rt * eps3rt * evdwij
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
! if (b2.gt.0.0) then
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
-! write (*,*) "sparrow = ", sparrow
- Chif = 1.0d0/rij * sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1 * ( eagle + b2 * ChiLambf - b3 )
- bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow=dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ if (b1.eq.0.0d0) sparrow=1.0d0
+ sparrow = 1.0d0 / sparrow
+! write (*,*) "sparrow = ", sparrow,sig1,sig2,b1
+ Chif = 1.0d0/rij * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1 * ( eagle + b2 * ChiLambf - b3 )
+ bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
! print *,i,j,Fcav
- dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
- dbot = 12.0d0 * b4 * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+ dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
+ dbot = 12.0d0 * b4 * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
! dFdR = 0.0d0
! write (*,*) "dFcav/dR = ", dFdR
- dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
- dbot = 12.0d0 * b4 * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
-
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
+ dbot = 12.0d0 * b4 * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
-
- ertail(1) = xj*rij
- ertail(2) = yj*rij
- ertail(3) = zj*rij
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
+
+ ertail(1) = xj*rij
+ ertail(2) = yj*rij
+ ertail(3) = zj*rij
! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
DO k = 1, 3
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
- pom = ertail(k)
+ pom = ertail(k)
!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
- - (( dFdR + gg(k) ) * pom)
+ gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
+ - (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! & - ( dFdR * pom )
- pom = ertail(k)
+ pom = ertail(k)
!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
- + (( dFdR + gg(k) ) * pom)
+ gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
+ + (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! & + ( dFdR * pom )
- gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
!c! & - ( dFdR * ertail(k))
- gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
+ gg(k) = 0.0d0
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
END DO
! endif
!Now dipole-dipole
- if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
+ if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
w1 = wdipdip_scbase(1,itypi,itypj)
w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
w3 = wdipdip_scbase(2,itypi,itypj)
fac = (om12 - 3.0d0 * om1 * om2)
c1 = (w1 / (Rhead**3.0d0)) * fac
c2 = (w2 / Rhead ** 6.0d0) &
- * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
c3= (w3/ Rhead ** 6.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
ECL = c1 - c2 + c3
!c! write (*,*) "w1 = ", w1
!c! write (*,*) "w2 = ", w2
!c! dECL/dr
c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
- * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
dGCLdR = c1 - c2 + c3
!c! dECL/dom1
c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
+ * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
dGCLdOM1 = c1 - c2 + c3
!c! dECL/dom2
c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
dGCLdOM2 = c1 - c2 + c3
!c! dECL/dom12
c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
dGCLdOM12 = c1 - c2 + c3
DO k= 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
+ erhead(k) = Rhead_distance(k)/Rhead
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
facd2 = d1j * vbld_inv(j+nres)
DO k = 1, 3
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
- - dGCLdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
- + dGCLdR * pom
-
- gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
- - dGCLdR * erhead(k)
- gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
- + dGCLdR * erhead(k)
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
+ - dGCLdR * pom
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
+ + dGCLdR * pom
+
+ gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
+ - dGCLdR * erhead(k)
+ gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
+ + dGCLdR * erhead(k)
END DO
endif
!now charge with dipole eg. ARG-dG
R1 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances tail is center of side-chain
- R1=R1+(c(k,j+nres)-chead(k,1))**2
+ R1=R1+(c(k,j+nres)-chead(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
sparrow = w1 * om1
hawk = w2 * (1.0d0 - sqom2)
Ecl = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ + 4.0d0 * hawk / Rhead**5.0d0
!c! dF/dom1
dGCLdOM1 = (w1) / (Rhead**2.0d0)
!c! dF/dom2
epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
! derivative of Epol is Gpol...
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdR1 = dPOLdFGB1 * dFGBdR1
! dPOLdR1 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
! facd1=0.0d0
! facd2=0.0d0
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
- - dGCLdR * pom &
- - dPOLdR1 * (erhead_tail(k,1))
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
+ - dGCLdR * pom &
+ - dPOLdR1 * (erhead_tail(k,1))
! & - dGLJdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
- + dGCLdR * pom &
- + dPOLdR1 * (erhead_tail(k,1))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
+ + dGCLdR * pom &
+ + dPOLdR1 * (erhead_tail(k,1))
! & + dGLJdR * pom
- gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
- - dGCLdR * erhead(k) &
- - dPOLdR1 * erhead_tail(k,1)
+ gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1)
! & - dGLJdR * erhead(k)
- gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
- + dGCLdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1)
+ gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1)
! & + dGLJdR * erhead(k)
END DO
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
enddo
return
real (kind=8) :: dcosom1(3),dcosom2(3)
eom1 = &
- eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der &
- + sigder * sigsq_om1 &
- + dCAVdOM1 &
- + dGCLdOM1 &
- + dPOLdOM1
+ eps2der * eps2rt_om1 &
+ - 2.0D0 * alf1 * eps3der &
+ + sigder * sigsq_om1 &
+ + dCAVdOM1 &
+ + dGCLdOM1 &
+ + dPOLdOM1
eom2 = &
- eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der &
- + sigder * sigsq_om2 &
- + dCAVdOM2 &
- + dGCLdOM2 &
- + dPOLdOM2
+ eps2der * eps2rt_om2 &
+ + 2.0D0 * alf2 * eps3der &
+ + sigder * sigsq_om2 &
+ + dCAVdOM2 &
+ + dGCLdOM2 &
+ + dPOLdOM2
eom12 = &
- evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der &
- + sigder *sigsq_om12 &
- + dCAVdOM12 &
- + dGCLdOM12
+ evdwij * eps1_om12 &
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der &
+ + sigder *sigsq_om12 &
+ + dCAVdOM12 &
+ + dGCLdOM12
! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
! gg(1),gg(2),"rozne"
DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
- gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
- + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
- + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
- gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
+ + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
+ + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
+ gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
END DO
+
RETURN
END SUBROUTINE sc_grad_scbase
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0ij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip
+ dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: epepbase
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
+ sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
eps_out=80.0d0
epepbase=0.0d0
! do i=1,nres_molec(1)-1
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
!C itypi = itype(i,1)
- dxi = dc_norm(1,i)
- dyi = dc_norm(2,i)
- dzi = dc_norm(3,i)
+ dxi = dc_norm(1,i)
+ dyi = dc_norm(2,i)
+ dzi = dc_norm(3,i)
! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
- dsci_inv = vbld_inv(i+1)/2.0
- xi=(c(1,i)+c(1,i+1))/2.0
- yi=(c(2,i)+c(2,i+1))/2.0
- zi=(c(3,i)+c(3,i+1))/2.0
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
- itypj= itype(j,2)
- if (itype(j,2).eq.ntyp1_molec(2))cycle
- xj=c(1,j+nres)
- yj=c(2,j+nres)
- zj=c(3,j+nres)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- dxj = dc_norm( 1, nres+j )
- dyj = dc_norm( 2, nres+j )
- dzj = dc_norm( 3, nres+j )
+ dsci_inv = vbld_inv(i+1)/2.0
+ xi=(c(1,i)+c(1,i+1))/2.0
+ yi=(c(2,i)+c(2,i+1))/2.0
+ zi=(c(3,i)+c(3,i+1))/2.0
+ call to_box(xi,yi,zi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
+ itypj= itype(j,2)
+ if (itype(j,2).eq.ntyp1_molec(2))cycle
+ xj=c(1,j+nres)
+ yj=c(2,j+nres)
+ zj=c(3,j+nres)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
! Gay-berne var's
- sig0ij = sigma_pepbase(itypj )
- chi1 = chi_pepbase(itypj,1 )
- chi2 = chi_pepbase(itypj,2 )
+ sig0ij = sigma_pepbase(itypj )
+ chi1 = chi_pepbase(itypj,1 )
+ chi2 = chi_pepbase(itypj,2 )
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
- chip1 = chipp_pepbase(itypj,1 )
- chip2 = chipp_pepbase(itypj,2 )
+ chi12 = chi1 * chi2
+ chip1 = chipp_pepbase(itypj,1 )
+ chip2 = chipp_pepbase(itypj,2 )
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
- chis1 = chis_pepbase(itypj,1)
- chis2 = chis_pepbase(itypj,2)
- chis12 = chis1 * chis2
- sig1 = sigmap1_pepbase(itypj)
- sig2 = sigmap2_pepbase(itypj)
+ chip12 = chip1 * chip2
+ chis1 = chis_pepbase(itypj,1)
+ chis2 = chis_pepbase(itypj,2)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_pepbase(itypj)
+ sig2 = sigmap2_pepbase(itypj)
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
DO k = 1,3
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = (c(k,i)+c(k,i+1))/2.0
+ chead(k,1) = (c(k,i)+c(k,i+1))/2.0
! + d1i * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres)
+ chead(k,2) = c(k, j+nres)
! + d1j * dc_norm(k, j+nres)
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
! print *,gvdwc_pepbase(k,i)
END DO
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
! alpha factors from Fcav/Gcav
- b1 = alphasur_pepbase(1,itypj)
+ b1 = alphasur_pepbase(1,itypj)
! b1=0.0d0
- b2 = alphasur_pepbase(2,itypj)
- b3 = alphasur_pepbase(3,itypj)
- b4 = alphasur_pepbase(4,itypj)
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ b2 = alphasur_pepbase(2,itypj)
+ b3 = alphasur_pepbase(3,itypj)
+ b4 = alphasur_pepbase(4,itypj)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
! print *,i,j,rrij
- rij = dsqrt(rrij)
+ rij = dsqrt(rrij)
!----------------------------
evdwij = 0.0d0
ECL = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
- CALL sc_angular
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
- rij_shift = 1.0/rij - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_pepbase(itypj)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
+ rij_shift = 1.0/rij - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_pepbase(itypj)
! c1 = 0.0d0
- c2 = fac * bb_pepbase(itypj)
+ c2 = fac * bb_pepbase(itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ evdwij = eps2rt * eps3rt * evdwij
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
! write (*,*) "sparrow = ", sparrow
- Chif = 1.0d0/rij * sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1 * ( eagle + b2 * ChiLambf - b3 )
- bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
+ Chif = 1.0d0/rij * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1 * ( eagle + b2 * ChiLambf - b3 )
+ bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
! print *,i,j,Fcav
- dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
- dbot = 12.0d0 * b4 * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+ dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
+ dbot = 12.0d0 * b4 * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
! dFdR = 0.0d0
! write (*,*) "dFcav/dR = ", dFdR
- dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
- dbot = 12.0d0 * b4 * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
-
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
+ dbot = 12.0d0 * b4 * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
- ertail(1) = xj*rij
- ertail(2) = yj*rij
- ertail(3) = zj*rij
+ ertail(1) = xj*rij
+ ertail(2) = yj*rij
+ ertail(3) = zj*rij
DO k = 1, 3
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
- pom = ertail(k)
+ pom = ertail(k)
!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
- - (( dFdR + gg(k) ) * pom)/2.0
+ gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
+ - (( dFdR + gg(k) ) * pom)/2.0
! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! & - ( dFdR * pom )
- pom = ertail(k)
+ pom = ertail(k)
!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
- + (( dFdR + gg(k) ) * pom)
+ gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
+ + (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! & + ( dFdR * pom )
- gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
- - (( dFdR + gg(k) ) * ertail(k))/2.0
+ gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
+ - (( dFdR + gg(k) ) * ertail(k))/2.0
! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
!c! & - ( dFdR * ertail(k))
- gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
+ gg(k) = 0.0d0
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
END DO
fac = (om12 - 3.0d0 * om1 * om2)
c1 = (w1 / (Rhead**3.0d0)) * fac
c2 = (w2 / Rhead ** 6.0d0) &
- * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
c3= (w3/ Rhead ** 6.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
ECL = c1 - c2 + c3
c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
- * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
dGCLdR = c1 - c2 + c3
!c! dECL/dom1
c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
+ * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
dGCLdOM1 = c1 - c2 + c3
!c! dECL/dom2
c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
dGCLdOM2 = c1 - c2 + c3
c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
dGCLdOM12 = c1 - c2 + c3
DO k= 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
+ erhead(k) = Rhead_distance(k)/Rhead
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
!+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
! - dGCLdR * pom
- pom = erhead(k)
+ pom = erhead(k)
!+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
- + dGCLdR * pom
+ gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
+ + dGCLdR * pom
- gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
- - dGCLdR * erhead(k)/2.0d0
+ gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
+ - dGCLdR * erhead(k)/2.0d0
! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
- gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
- - dGCLdR * erhead(k)/2.0d0
+ gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
+ - dGCLdR * erhead(k)/2.0d0
! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
- gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
- + dGCLdR * erhead(k)
+ gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
+ + dGCLdR * erhead(k)
END DO
! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
epepbase=epepbase+evdwij+Fcav+ECL
+ 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
real (kind=8) :: dcosom1(3),dcosom2(3)
eom1 = &
- eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der &
- + sigder * sigsq_om1 &
- + dCAVdOM1 &
- + dGCLdOM1 &
- + dPOLdOM1
+ eps2der * eps2rt_om1 &
+ - 2.0D0 * alf1 * eps3der &
+ + sigder * sigsq_om1 &
+ + dCAVdOM1 &
+ + dGCLdOM1 &
+ + dPOLdOM1
eom2 = &
- eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der &
- + sigder * sigsq_om2 &
- + dCAVdOM2 &
- + dGCLdOM2 &
- + dPOLdOM2
+ eps2der * eps2rt_om2 &
+ + 2.0D0 * alf2 * eps3der &
+ + sigder * sigsq_om2 &
+ + dCAVdOM2 &
+ + dGCLdOM2 &
+ + dPOLdOM2
eom12 = &
- evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der &
- + sigder *sigsq_om12 &
- + dCAVdOM12 &
- + dGCLdOM12
+ evdwij * eps1_om12 &
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der &
+ + sigder *sigsq_om12 &
+ + dCAVdOM12 &
+ + dGCLdOM12
! om12=0.0
! eom12=0.0
! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
! gg(1),gg(2),"rozne"
DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
- gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
- + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
- *dsci_inv*2.0 &
- - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
- gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
- - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
- *dsci_inv*2.0 &
- + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+ dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
+ + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
+ *dsci_inv*2.0 &
+ - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+ gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
+ - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
+ *dsci_inv*2.0 &
+ + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
! print *,eom12,eom2,om12,om2
!eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
- gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
- + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
- + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
+ gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
+ + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
END DO
RETURN
END SUBROUTINE sc_grad_pepbase
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'
!el local variables
integer :: iint,itypi,itypi1,itypj,subchap
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
- real(kind=8) :: evdw,sig0ij
+ real(kind=8) :: evdw,sig0ij,aa,bb
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip,alpha_sco
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: escpho
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
+ sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
eps_out=80.0d0
escpho=0.0d0
! do i=1,nres_molec(1)
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1)) cycle
- itypi = itype(i,1)
- dxi = dc_norm(1,nres+i)
- dyi = dc_norm(2,nres+i)
- dzi = dc_norm(3,nres+i)
- dsci_inv = vbld_inv(i+nres)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
- itypj= itype(j,2)
- if ((itype(j,2).eq.ntyp1_molec(2)).or.&
- (itype(j+1,2).eq.ntyp1_molec(2))) cycle
- xj=(c(1,j)+c(1,j+1))/2.0
- yj=(c(2,j)+c(2,j+1))/2.0
- zj=(c(3,j)+c(3,j+1))/2.0
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1)) cycle
+ itypi = itype(i,1)
+ dxi = dc_norm(1,nres+i)
+ dyi = dc_norm(2,nres+i)
+ dzi = dc_norm(3,nres+i)
+ dsci_inv = vbld_inv(i+nres)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
+ itypj= itype(j,2)
+ if ((itype(j,2).eq.ntyp1_molec(2)).or.&
+ (itype(j+1,2).eq.ntyp1_molec(2))) cycle
+ xj=(c(1,j)+c(1,j+1))/2.0
+ yj=(c(2,j)+c(2,j+1))/2.0
+ zj=(c(3,j)+c(3,j+1))/2.0
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+! bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+! +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj = dc_norm( 1,j )
- dyj = dc_norm( 2,j )
- dzj = dc_norm( 3,j )
- dscj_inv = vbld_inv(j+1)
+ dyj = dc_norm( 2,j )
+ dzj = dc_norm( 3,j )
+ dscj_inv = vbld_inv(j+1)
! Gay-berne var's
- sig0ij = sigma_scpho(itypi )
- chi1 = chi_scpho(itypi,1 )
- chi2 = chi_scpho(itypi,2 )
+ sig0ij = sigma_scpho(itypi )
+ chi1 = chi_scpho(itypi,1 )
+ chi2 = chi_scpho(itypi,2 )
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
- chip1 = chipp_scpho(itypi,1 )
- chip2 = chipp_scpho(itypi,2 )
+ chi12 = chi1 * chi2
+ chip1 = chipp_scpho(itypi,1 )
+ chip2 = chipp_scpho(itypi,2 )
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
- chis1 = chis_scpho(itypi,1)
- chis2 = chis_scpho(itypi,2)
- chis12 = chis1 * chis2
- sig1 = sigmap1_scpho(itypi)
- sig2 = sigmap2_scpho(itypi)
+ chip12 = chip1 * chip2
+ chis1 = chis_scpho(itypi,1)
+ chis2 = chis_scpho(itypi,2)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_scpho(itypi)
+ sig2 = sigmap2_scpho(itypi)
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
- b1 = alphasur_scpho(1,itypi)
+ b1 = alphasur_scpho(1,itypi)
! b1=0.0d0
- b2 = alphasur_scpho(2,itypi)
- b3 = alphasur_scpho(3,itypi)
- b4 = alphasur_scpho(4,itypi)
+ b2 = alphasur_scpho(2,itypi)
+ b3 = alphasur_scpho(3,itypi)
+ b4 = alphasur_scpho(4,itypi)
! used to determine whether we want to do quadrupole calculations
! used by Fgb
eps_in = epsintab_scpho(itypi)
! write (*,*) "eps_inout_fac = ", eps_inout_fac
!-------------------------------------------------------------------
! tail location and distance calculations
- d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
- d1j = 0.0
+ d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
+ d1j = 0.0
DO k = 1,3
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
- chead(k,2) = (c(k, j) + c(k, j+1))/2.0
+ chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
+ chead(k,2) = (c(k, j) + c(k, j+1))/2.0
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
Rhead_sq=Rhead**2.0
!-------------------------------------------------------------------
! zero everything that should be zero'ed
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+1)/2.0
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+1)/2.0
!dhead_scbasej(itypi,itypj)
! print *,i,j,dscj_inv,dsci_inv
! rij holds 1/(distance of Calpha atoms)
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
!----------------------------
- CALL sc_angular
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = 1.0/rij - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_scpho(itypi)
+ rij_shift = 1.0/rij - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_scpho(itypi)
! c1 = 0.0d0
- c2 = fac * bb_scpho(itypi)
+ c2 = fac * bb_scpho(itypi)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ evdwij = eps2rt * eps3rt * evdwij
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
! write (*,*) "sparrow = ", sparrow
- Chif = 1.0d0/rij * sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1 * ( eagle + b2 * ChiLambf - b3 )
- bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
- dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
- dbot = 12.0d0 * b4 * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+ Chif = 1.0d0/rij * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1 * ( eagle + b2 * ChiLambf - b3 )
+ bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
+ dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
+ dbot = 12.0d0 * b4 * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
! dFdR = 0.0d0
! write (*,*) "dFcav/dR = ", dFdR
- dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
- dbot = 12.0d0 * b4 * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
-
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
+ dbot = 12.0d0 * b4 * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
- ertail(1) = xj*rij
- ertail(2) = yj*rij
- ertail(3) = zj*rij
+ ertail(1) = xj*rij
+ ertail(2) = yj*rij
+ ertail(3) = zj*rij
DO k = 1, 3
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
- pom = ertail(k)
+ pom = ertail(k)
! print *,pom,gg(k),dFdR
!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
- - (( dFdR + gg(k) ) * pom)
+ gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
+ - (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! & - ( dFdR * pom )
! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! & + ( dFdR * pom )
- gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
!c! & - ( dFdR * ertail(k))
- gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))/2.0
+ gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))/2.0
- gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
- + (( dFdR + gg(k) ) * ertail(k))/2.0
+ gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
+ + (( dFdR + gg(k) ) * ertail(k))/2.0
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
- ENDDO
+ gg(k) = 0.0d0
+ ENDDO
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
! alphapol1 = alphapol_scpho(itypi)
Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead
!c! derivative of Ecl is Gcl...
dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* &
- (Rhead*alpha_sco+1) ) / Rhead_sq
+ (Rhead*alpha_sco+1) ) / Rhead_sq
if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij
else if (wqdip_scpho(2,itypi).gt.0.0d0) then
w1 = wqdip_scpho(1,itypi)
sparrow = w1 * om1
hawk = w2 * (1.0d0 - sqom2)
Ecl = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
- 1.0/rij,sparrow
+ 1.0/rij,sparrow
!c! derivative of ecl is Gcl
!c! dF/dr part
dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ + 4.0d0 * hawk / Rhead**5.0d0
!c! dF/dom1
dGCLdOM1 = (w1) / (Rhead**2.0d0)
!c! dF/dom2
R1 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances tail is center of side-chain
- R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
+ R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
! derivative of Epol is Gpol...
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdR1 = dPOLdFGB1 * dFGBdR1
! dPOLdR1 = 0.0d0
! dPOLdOM1 = 0.0d0
dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
dPOLdOM2 = 0.0
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
! facd1=0.0d0
! facd2=0.0d0
! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
! pom,(erhead_tail(k,1))
! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
- - dGCLdR * pom &
- - dPOLdR1 * (erhead_tail(k,1))
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
+ - dGCLdR * pom &
+ - dPOLdR1 * (erhead_tail(k,1))
! & - dGLJdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
! + dGCLdR * pom &
! + dPOLdR1 * (erhead_tail(k,1))
! & + dGLJdR * pom
- gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
- - dGCLdR * erhead(k) &
- - dPOLdR1 * erhead_tail(k,1)
+ gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1)
! & - dGLJdR * erhead(k)
- gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
- + (dGCLdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1))/2.0
- gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
- + (dGCLdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1))/2.0
+ gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
+ + (dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1))/2.0
+ gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
+ + (dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1))/2.0
! & + dGLJdR * erhead(k)
! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
END DO
! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
- "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
+ "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
escpho=escpho+evdwij+epol+Fcav+ECL
call sc_grad_scpho
- enddo
+ enddo
enddo
real (kind=8) :: dcosom1(3),dcosom2(3)
eom1 = &
- eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der &
- + sigder * sigsq_om1 &
- + dCAVdOM1 &
- + dGCLdOM1 &
- + dPOLdOM1
+ eps2der * eps2rt_om1 &
+ - 2.0D0 * alf1 * eps3der &
+ + sigder * sigsq_om1 &
+ + dCAVdOM1 &
+ + dGCLdOM1 &
+ + dPOLdOM1
eom2 = &
- eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der &
- + sigder * sigsq_om2 &
- + dCAVdOM2 &
- + dGCLdOM2 &
- + dPOLdOM2
+ eps2der * eps2rt_om2 &
+ + 2.0D0 * alf2 * eps3der &
+ + sigder * sigsq_om2 &
+ + dCAVdOM2 &
+ + dGCLdOM2 &
+ + dPOLdOM2
eom12 = &
- evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der &
- + sigder *sigsq_om12 &
- + dCAVdOM12 &
- + dGCLdOM12
+ evdwij * eps1_om12 &
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der &
+ + sigder *sigsq_om12 &
+ + dCAVdOM12 &
+ + dGCLdOM12
! om12=0.0
! eom12=0.0
! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
! gg(1),gg(2),"rozne"
DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
- gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
- + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
- *dscj_inv*2.0 &
- - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
- - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
- *dscj_inv*2.0 &
- + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
- + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
+ + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
+ *dscj_inv*2.0 &
+ - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
+ gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
+ - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
+ *dscj_inv*2.0 &
+ + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
+ gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
+ + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! print *,eom12,eom2,om12,om2
!eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
+ gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
END DO
RETURN
END SUBROUTINE sc_grad_scpho
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'
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0ij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip
+ dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: epeppho
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
+ sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
real (kind=8) :: dcosom1(3),dcosom2(3)
epeppho=0.0d0
! do i=1,nres_molec(1)
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1)) cycle
- itypi = itype(i,1)
- dsci_inv = vbld_inv(i+1)/2.0
- dxi = dc_norm(1,i)
- dyi = dc_norm(2,i)
- dzi = dc_norm(3,i)
- xi=(c(1,i)+c(1,i+1))/2.0
- yi=(c(2,i)+c(2,i+1))/2.0
- zi=(c(3,i)+c(3,i+1))/2.0
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
- itypj= itype(j,2)
- if ((itype(j,2).eq.ntyp1_molec(2)).or.&
- (itype(j+1,2).eq.ntyp1_molec(2))) cycle
- xj=(c(1,j)+c(1,j+1))/2.0
- yj=(c(2,j)+c(2,j+1))/2.0
- zj=(c(3,j)+c(3,j+1))/2.0
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
- dxj = dc_norm( 1,j )
- dyj = dc_norm( 2,j )
- dzj = dc_norm( 3,j )
- dscj_inv = vbld_inv(j+1)/2.0
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1)) cycle
+ itypi = itype(i,1)
+ dsci_inv = vbld_inv(i+1)/2.0
+ dxi = dc_norm(1,i)
+ dyi = dc_norm(2,i)
+ dzi = dc_norm(3,i)
+ xi=(c(1,i)+c(1,i+1))/2.0
+ yi=(c(2,i)+c(2,i+1))/2.0
+ zi=(c(3,i)+c(3,i+1))/2.0
+ call to_box(xi,yi,zi)
+
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
+ itypj= itype(j,2)
+ if ((itype(j,2).eq.ntyp1_molec(2)).or.&
+ (itype(j+1,2).eq.ntyp1_molec(2))) cycle
+ xj=(c(1,j)+c(1,j+1))/2.0
+ yj=(c(2,j)+c(2,j+1))/2.0
+ zj=(c(3,j)+c(3,j+1))/2.0
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dist_init=xj**2+yj**2+zj**2
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ dxj = dc_norm( 1,j )
+ dyj = dc_norm( 2,j )
+ dzj = dc_norm( 3,j )
+ dscj_inv = vbld_inv(j+1)/2.0
! Gay-berne var's
- sig0ij = sigma_peppho
+ sig0ij = sigma_peppho
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
+ chi12 = chi1 * chi2
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
+ chip12 = chip1 * chip2
! chis1 = 0.0d0
! chis2 = 0.0d0
- chis12 = chis1 * chis2
- sig1 = sigmap1_peppho
- sig2 = sigmap2_peppho
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_peppho
+ sig2 = sigmap2_peppho
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- b1 = alphasur_peppho(1)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ b1 = alphasur_peppho(1)
! b1=0.0d0
- b2 = alphasur_peppho(2)
- b3 = alphasur_peppho(3)
- b4 = alphasur_peppho(4)
- CALL sc_angular
+ b2 = alphasur_peppho(2)
+ b3 = alphasur_peppho(3)
+ b4 = alphasur_peppho(4)
+ CALL sc_angular
sqom1=om1*om1
evdwij = 0.0d0
ECL = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- rij_shift = rij
- fac = rij_shift**expon
- c1 = fac * fac * aa_peppho
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ rij_shift = rij
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_peppho
! c1 = 0.0d0
- c2 = fac * bb_peppho
+ c2 = fac * bb_peppho
! c2 = 0.0d0
- evdwij = c1 + c2
+ evdwij = c1 + c2
! Now cavity....................
eagle = dsqrt(1.0/rij_shift)
top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
- bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
- dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
- dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
- dFdR = ((dtop * bot - top * dbot) / botsq)
+ bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
+ dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
+ dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
+ dFdR = ((dtop * bot - top * dbot) / botsq)
w1 = wqdip_peppho(1)
w2 = wqdip_peppho(2)
! w1=0.0d0
sparrow = w1 * om1
hawk = w2 * (1.0d0 - sqom1)
Ecl = sparrow * rij_shift**2.0d0 &
- - hawk * rij_shift**4.0d0
+ - hawk * rij_shift**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
! rij_shift=5.0
dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
- + 4.0d0 * hawk * rij_shift**5.0d0
+ + 4.0d0 * hawk * rij_shift**5.0d0
!c! dF/dom1
dGCLdOM1 = (w1) * (rij_shift**2.0d0)
!c! dF/dom2
eom1 = dGCLdOM1+dGCLdOM2
eom2 = 0.0
- fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
+ fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
! fac=0.0
- gg(1) = fac*xj*rij
- gg(2) = fac*yj*rij
- gg(3) = fac*zj*rij
- do k=1,3
- gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
- gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
- gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
- gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
- gg(k)=0.0
- enddo
+ gg(1) = fac*xj*rij
+ gg(2) = fac*yj*rij
+ gg(3) = fac*zj*rij
+ do k=1,3
+ gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
+ gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
+ gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
+ gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
+ gg(k)=0.0
+ enddo
DO k = 1, 3
- dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
- dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
- gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
+ dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
+ dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
+ gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
+ gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
- - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
- gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
- + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
- enddo
+ gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
+ - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+ gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
+ + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+ enddo
+ 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
+ real(kind=8) :: evdw,aa,bb
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip,alpha_sco
- integer :: ii
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
+ integer :: ii,icont
real(kind=8) :: fracinbuf
real (kind=8) :: escpho
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,egb
real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
- Lambf,&
- Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
- dFdOM2,dFdL,dFdOM12,&
- federmaus,&
- d1i,d1j
+ Lambf,&
+ Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
+ dFdOM2,dFdL,dFdOM12,&
+ federmaus,&
+ d1i,d1j
! real(kind=8),dimension(3,2)::erhead_tail
! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
real(kind=8) :: facd4, adler, Fgb, facd3
integer troll,jj,istate
real (kind=8) :: dcosom1(3),dcosom2(3)
+ evdw=0.0d0
eps_out=80.0d0
sss_ele_cut=1.0d0
+ countss=0
! print *,"EVDW KURW",evdw,nres
- do i=iatsc_s,iatsc_e
+! do i=iatsc_s,iatsc_e
! print *,"I am in EVDW",i
- itypi=iabs(itype(i,1))
+ 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
- itypi1=iabs(itype(i+1,1))
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=dmod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=dmod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=dmod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
- if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
-!C the energy transfer exist
- if (zi.lt.buflipbot) then
-!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
-!C lipbufthick is thickenes of lipid buffore
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
- elseif (zi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
- sslipi=sscalelip(fracinbuf)
- ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
- else
- sslipi=1.0d0
- ssgradlipi=0.0
- endif
- else
- sslipi=0.0d0
- ssgradlipi=0.0
- endif
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1,1))
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+! endif
! print *, sslipi,ssgradlipi
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
+ dsci_inv=vbld_inv(i+nres)
! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
!
! Calculate SC interaction energy.
!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
+! do iint=1,nint_gr(i)
+! do j=istart(i,iint),iend(i,iint)
! print *,"JA PIER",i,j,iint,istart(i,iint),iend(i,iint)
- IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
- call dyn_ssbond_ene(i,j,evdwij)
- evdw=evdw+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
- 'evdw',i,j,evdwij,' ss'
+ IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
+ call dyn_ssbond_ene(i,j,evdwij,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,iend(i,iint)
!C search over all next residues
- if (dyn_ss_mask(k)) then
+ if (dyn_ss_mask(k)) then
!C check if they are cysteins
!C write(iout,*) 'k=',k
!c write(iout,*) "PRZED TRI", evdwij
! evdwij_przed_tri=evdwij
- call triple_ssbond_ene(i,j,k,evdwij)
+ call triple_ssbond_ene(i,j,k,evdwij)
!c if(evdwij_przed_tri.ne.evdwij) then
!c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
!c endif
!c write(iout,*) "PO TRI", evdwij
!C call the energy function that removes the artifical triple disulfide
!C bond the soubroutine is located in ssMD.F
- evdw=evdw+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
- 'evdw',i,j,evdwij,'tss'
- endif!dyn_ss_mask(k)
- enddo! k
- ELSE
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
+ 'evdw',i,j,evdwij,'tss'
+ endif!dyn_ss_mask(k)
+ enddo! k
+ ELSE
!el ind=ind+1
- itypj=iabs(itype(j,1))
- if (itypj.eq.ntyp1) cycle
- CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+ itypj=iabs(itype(j,1))
+ if (itypj.eq.ntyp1) cycle
+ CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
! if (j.ne.78) cycle
! dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- xj=c(1,j+nres)
- yj=c(2,j+nres)
- zj=c(3,j+nres)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- dxj = dc_norm( 1, nres+j )
- dyj = dc_norm( 2, nres+j )
- dzj = dc_norm( 3, nres+j )
+ dscj_inv=vbld_inv(j+nres)
+ xj=c(1,j+nres)
+ yj=c(2,j+nres)
+ zj=c(3,j+nres)
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! write(iout,*) "KRUWA", i,j
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ Rreal(1)=xj
+ Rreal(2)=yj
+ Rreal(3)=zj
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
! print *,i,j,itypi,itypj
! d1i=0.0d0
! d1j=0.0d0
! chip2=0.0d0
! not used by momo potential, but needed by sc_angular which is shared
! by all energy_potential subroutines
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
! a12sq = a12sq * a12sq
! charge of amino acid itypi is...
- chis1 = chis(itypi,itypj)
- chis2 = chis(itypj,itypi)
- chis12 = chis1 * chis2
- sig1 = sigmap1(itypi,itypj)
- sig2 = sigmap2(itypi,itypj)
+ chis1 = chis(itypi,itypj)
+ chis2 = chis(itypj,itypi)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1(itypi,itypj)
+ sig2 = sigmap2(itypi,itypj)
! write (*,*) "sig1 = ", sig1
! chis1=0.0
! chis2=0.0
! sig2=0.0
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- b1cav = alphasur(1,itypi,itypj)
+ b1cav = alphasur(1,itypi,itypj)
! b1cav=0.0d0
- b2cav = alphasur(2,itypi,itypj)
- b3cav = alphasur(3,itypi,itypj)
- b4cav = alphasur(4,itypi,itypj)
+ b2cav = alphasur(2,itypi,itypj)
+ b3cav = alphasur(3,itypi,itypj)
+ b4cav = alphasur(4,itypi,itypj)
! used to determine whether we want to do quadrupole calculations
eps_in = epsintab(itypi,itypj)
if (eps_in.eq.0.0) eps_in=1.0
-
+
eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
Rtail = 0.0d0
! dtail(1,itypi,itypj)=0.0
! dtail(2,itypi,itypj)=0.0
DO k = 1, 3
- ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
- ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
+ ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
+ ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
END DO
+ 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)) &
- + (Rtail_distance(3)*Rtail_distance(3)))
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
! write (*,*) "eps_inout_fac = ", eps_inout_fac
!-------------------------------------------------------------------
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
-! distance
+ 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
+ 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)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!-------------------------------------------------------------------
! zero everything that should be zero'ed
evdwij = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
! print *,i,j,dscj_inv,dsci_inv
! rij holds 1/(distance of Calpha atoms)
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ 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
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = Rtail - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_aq(itypi,itypj)
+ rij_shift = Rtail - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_aq(itypi,itypj)
! print *,"ADAM",aa_aq(itypi,itypj)
! c1 = 0.0d0
- c2 = fac * bb_aq(itypi,itypj)
+ c2 = fac * bb_aq(itypi,itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
+ evdwij = eps2rt * eps3rt * evdwij
!#ifdef TSCSC
! IF (bb_aq(itypi,itypj).gt.0) THEN
! evdw_p = evdw_p + evdwij
! evdw_m = evdw_m + evdwij
! END IF
!#else
- evdw = evdw &
- + evdwij
+ evdw = evdw &
+ + evdwij*sss_ele_cut
!#endif
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
+ gg(1) = fac*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
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
! print *,"fac,pom",fac,pom,Lambf
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
! print *,"sig1,sig2",sig1,sig2,itypi,itypj
! write (*,*) "sparrow = ", sparrow
- Chif = Rtail * sparrow
+ Chif = Rtail * sparrow
! print *,"rij,sparrow",rij , sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
- bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
- botsq = bot * bot
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
+ bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
! print *,top,bot,"bot,top",ChiLambf,Chif
- Fcav = top / bot
+ Fcav = top / bot
dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
dbot = 12.0d0 * b4cav * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
-
- dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
- dbot = 12.0d0 * b4cav * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
-
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow*sss_ele_cut
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
DO k= 1, 3
- ertail(k) = Rtail_distance(k)/Rtail
+ ertail(k) = Rtail_distance(k)/Rtail
END DO
erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
DO k = 1, 3
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
- pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwx(k,i) = gvdwx(k,i) &
- - (( dFdR + gg(k) ) * pom)
+ pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i) &
+ - (( dFdR + gg(k) ) * pom)&
+ -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)
+ pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j) &
+ + (( dFdR + gg(k) ) * pom) &
+ +sss_ele_grad*Rreal(k)*rij*(Fcav+evdwij)
+
!c! & + ( dFdR * pom )
- gvdwc(k,i) = gvdwc(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
+ gvdwc(k,i) = gvdwc(k,i) &
+ - (( 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))
+ gvdwc(k,j) = gvdwc(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k)) &
+ +sss_ele_grad*Rreal(k)*rij*(Fcav+evdwij)
+
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
+ gg(k) = 0.0d0
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
END DO
-
+
!c! Compute head-head and head-tail energies for each state
- isel = iabs(Qi) + iabs(Qj)
+ isel = iabs(Qi) + iabs(Qj)
! double charge for Phophorylated! itype - 25,27,27
! if ((itype(i).eq.27).or.(itype(i).eq.26).or.(itype(i).eq.25)) then
! Qi=Qi*2
! endif
! isel=0
- IF (isel.eq.0) THEN
+! 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
+ eheadtail = 0.0d0
- ELSE IF (isel.eq.4) THEN
+ ELSE IF (isel.eq.4) THEN
!c! Calculate dipole-dipole interactions
- CALL edd(ecl)
- eheadtail = ECL
+ CALL edd(ecl)
+ eheadtail = ECL
! eheadtail = 0.0d0
- ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
+ ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
!c! Charge-nonpolar interactions
- 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
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
- CALL eqn(epol)
- eheadtail = epol
+ CALL eqn(epol)
+ eheadtail = epol
! eheadtail = 0.0d0
- ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
+ ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
!c! Nonpolar-charge interactions
- 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
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
- CALL enq(epol)
- eheadtail = epol
+ CALL enq(epol)
+ eheadtail = epol
! eheadtail = 0.0d0
- ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
+ ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
!c! Charge-dipole interactions
- 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
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
- CALL eqd(ecl, elj, epol)
- eheadtail = ECL + elj + epol
+ CALL eqd(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
! eheadtail = 0.0d0
- ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
+ ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
!c! Dipole-charge interactions
- if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
- Qi=Qi*2
- Qij=Qij*2
- endif
- if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
- Qj=Qj*2
- Qij=Qij*2
- endif
- CALL edq(ecl, elj, epol)
- eheadtail = ECL + elj + epol
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
+ CALL edq(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
! eheadtail = 0.0d0
- ELSE IF ((isel.eq.2.and. &
- iabs(Qi).eq.1).and. &
- nstate(itypi,itypj).eq.1) THEN
+ ELSE IF ((isel.eq.2.and. &
+ iabs(Qi).eq.1).and. &
+ nstate(itypi,itypj).eq.1) THEN
!c! Same charge-charge interaction ( +/+ or -/- )
- 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
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
- CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
- eheadtail = ECL + Egb + Epol + Fisocav + Elj
+ CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
+ eheadtail = ECL + Egb + Epol + Fisocav + Elj
! eheadtail = 0.0d0
- ELSE IF ((isel.eq.2.and. &
- iabs(Qi).eq.1).and. &
- nstate(itypi,itypj).ne.1) THEN
+ ELSE IF ((isel.eq.2.and. &
+ iabs(Qi).eq.1).and. &
+ nstate(itypi,itypj).ne.1) THEN
!c! Different charge-charge interaction ( +/- or -/+ )
- 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
+ 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
+ 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,&
- 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
- Equad,evdwij+Fcav+eheadtail,evdw
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+ Equad,evdwij+Fcav+eheadtail,evdw
! evdw = evdw + Fcav + eheadtail
- iF (nstate(itypi,itypj).eq.1) THEN
- CALL sc_grad
+ iF (nstate(itypi,itypj).eq.1) THEN
+ CALL sc_grad
END IF
!c!-------------------------------------------------------------------
!c! NAPISY KONCOWE
- END DO ! j
- END DO ! iint
+ ! END DO ! j
+ !END DO ! iint
END DO ! i
!c write (iout,*) "Number of loop steps in EGB:",ind
!c energy_dec=.false.
use calc_data
use comm_momo
real (kind=8) :: facd3, facd4, federmaus, adler,&
- Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
+ Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap,sgrad
! integer :: k
!c! Epol and Gpol analytical parameters
alphapol1 = alphapol(itypi,itypj)
al3 = alphiso(3,itypi,itypj)
al4 = alphiso(4,itypi,itypj)
csig = (1.0d0 &
- / dsqrt(sigiso1(itypi, itypj)**2.0d0 &
- + sigiso2(itypi,itypj)**2.0d0))
+ / dsqrt(sigiso1(itypi, itypj)**2.0d0 &
+ + sigiso2(itypi,itypj)**2.0d0))
!c!
pis = sig0head(itypi,itypj)
eps_head = epshead(itypi,itypj)
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances needed by Epol
- R1=R1+(ctail(k,2)-chead(k,1))**2
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R1=R1+(ctail(k,2)-chead(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
!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
Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
debkap=debaykap(itypi,itypj)
Egb = -(332.0d0 * Qij *&
- (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
+ (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
+ (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"
(( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
!c! epol = 0.0d0
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
- / ( 2.0d0 * fgb1 )
+ / ( 2.0d0 * fgb1 )
dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
- / ( 2.0d0 * fgb2 )
+ / ( 2.0d0 * fgb2 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
- * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
- * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
- dPOLdR1 = dPOLdFGB1 * dFGBdR1
+ * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
+ 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
!c! distance to function that changes with LOCATION (of the interaction
!c! site)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
!c! Now we add appropriate partial derivatives (one in each dimension)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
- condor = (erhead_tail(k,2) + &
- facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
-
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx(k,i) = gvdwx(k,i) &
- - dGCLdR * pom&
- - dGGBdR * pom&
- - dGCVdR * pom&
- - dPOLdR1 * hawk&
- - dPOLdR2 * (erhead_tail(k,2)&
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ condor = (erhead_tail(k,2) + &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
+ sgrad=(Ecl+Egb+Epol+Fisocav+Elj)*sss_ele_grad*rreal(k)*rij
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dGCLdR * pom&
+ - dGGBdR * pom&
+ - dGCVdR * pom&
+ - dPOLdR1 * hawk&
+ - dPOLdR2 * (erhead_tail(k,2)&
-facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
- - dGLJdR * pom
+ - 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)&
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom&
+ + dGGBdR * pom+ dGCVdR * pom&
+ + dPOLdR1 * (erhead_tail(k,1)&
-facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
- + dPOLdR2 * condor + dGLJdR * pom
-
- gvdwc(k,i) = gvdwc(k,i) &
- - dGCLdR * erhead(k)&
- - dGGBdR * erhead(k)&
- - dGCVdR * erhead(k)&
- - dPOLdR1 * erhead_tail(k,1)&
- - dPOLdR2 * erhead_tail(k,2)&
- - dGLJdR * erhead(k)
-
- gvdwc(k,j) = gvdwc(k,j) &
- + dGCLdR * erhead(k) &
- + dGGBdR * erhead(k) &
- + dGCVdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1) &
- + dPOLdR2 * erhead_tail(k,2)&
- + dGLJdR * erhead(k)
+ + dPOLdR2 * condor + dGLJdR * pom+sgrad
+
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dGCLdR * erhead(k)&
+ - dGGBdR * erhead(k)&
+ - dGCVdR * erhead(k)&
+ - dPOLdR1 * erhead_tail(k,1)&
+ - dPOLdR2 * erhead_tail(k,2)&
+ - dGLJdR * erhead(k)-sgrad
+
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dGCLdR * erhead(k) &
+ + dGGBdR * erhead(k) &
+ + dGCVdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dPOLdR2 * erhead_tail(k,2)&
+ + dGLJdR * erhead(k)+sgrad
END DO
RETURN
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
! 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)
al3 = alphisocat(3,itypi,itypj)
al4 = alphisocat(4,itypi,itypj)
csig = (1.0d0 &
- / dsqrt(sigiso1cat(itypi, itypj)**2.0d0 &
- + sigiso2cat(itypi,itypj)**2.0d0))
+ / dsqrt(sigiso1cat(itypi, itypj)**2.0d0 &
+ + sigiso2cat(itypi,itypj)**2.0d0))
!c!
pis = sig0headcat(itypi,itypj)
eps_head = epsheadcat(itypi,itypj)
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances needed by Epol
- R1=R1+(ctail(k,2)-chead(k,1))**2
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R1=R1+(ctail(k,2)-chead(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
!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
+ (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
+ (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"
(( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
!c! epol = 0.0d0
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
- / ( 2.0d0 * fgb1 )
+ / ( 2.0d0 * fgb1 )
dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
- / ( 2.0d0 * fgb2 )
+ / ( 2.0d0 * fgb2 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
- * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
- * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
- dPOLdR1 = dPOLdFGB1 * dFGBdR1
+ * ( 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
+ 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
!c! distance to function that changes with LOCATION (of the interaction
!c! site)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
!c! Now we add appropriate partial derivatives (one in each dimension)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
- condor = (erhead_tail(k,2) + &
- facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
-
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gradpepcatx(k,i) = gradpepcatx(k,i) &
- - dGCLdR * pom&
- - dGGBdR * pom&
- - dGCVdR * pom&
- - dPOLdR1 * hawk&
- - dPOLdR2 * (erhead_tail(k,2)&
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ condor = (erhead_tail(k,2) + &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - dGCLdR * pom&
+ - dGGBdR * pom&
+ - dGCVdR * pom&
+ - dPOLdR1 * hawk&
+ - dPOLdR2 * (erhead_tail(k,2)&
-facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
- - dGLJdR * pom
+ - dGLJdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
! gradpepcatx(k,j) = gradpepcatx(k,j)+ dGCLdR * pom&
! + dGGBdR * pom+ dGCVdR * pom&
! + dPOLdR1 * (erhead_tail(k,1)&
! -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j)))&
! + dPOLdR2 * condor + dGLJdR * pom
- gradpepcat(k,i) = gradpepcat(k,i) &
- - dGCLdR * erhead(k)&
- - dGGBdR * erhead(k)&
- - dGCVdR * erhead(k)&
- - dPOLdR1 * erhead_tail(k,1)&
- - dPOLdR2 * erhead_tail(k,2)&
- - dGLJdR * erhead(k)
-
- gradpepcat(k,j) = gradpepcat(k,j) &
- + dGCLdR * erhead(k) &
- + dGGBdR * erhead(k) &
- + dGCVdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1) &
- + dPOLdR2 * erhead_tail(k,2)&
- + dGLJdR * erhead(k)
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - dGCLdR * erhead(k)&
+ - dGGBdR * erhead(k)&
+ - dGCVdR * erhead(k)&
+ - dPOLdR1 * erhead_tail(k,1)&
+ - dPOLdR2 * erhead_tail(k,2)&
+ - dGLJdR * erhead(k)
+
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dGCLdR * erhead(k) &
+ + dGGBdR * erhead(k) &
+ + dGCVdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dPOLdR2 * erhead_tail(k,2)&
+ + dGLJdR * erhead(k)
END DO
RETURN
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"
al3 = alphiso(3,itypi,itypj)
al4 = alphiso(4,itypi,itypj)
csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0&
- + sigiso2(itypi,itypj)**2.0d0))
+ + sigiso2(itypi,itypj)**2.0d0))
!c!
w1 = wqdip(1,itypi,itypj)
w2 = wqdip(2,itypi,itypj)
!c! First things first:
!c! We need to do sc_grad's job with GB and Fcav
eom1 = eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der&
- + sigder * sigsq_om1&
- + dCAVdOM1
+ - 2.0D0 * alf1 * eps3der&
+ + sigder * sigsq_om1&
+ + dCAVdOM1
eom2 = eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der&
- + sigder * sigsq_om2&
- + dCAVdOM2
+ + 2.0D0 * alf2 * eps3der&
+ + sigder * sigsq_om2&
+ + dCAVdOM2
eom12 = evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der&
- + sigder *sigsq_om12&
- + dCAVdOM12
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der&
+ + sigder *sigsq_om12&
+ + dCAVdOM12
!c! now some magical transformations to project gradient into
!c! three cartesian vectors
DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
!c! this acts on hydrophobic center of interaction
- gvdwx(k,i)= gvdwx(k,i) - gg(k) &
- + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)= gvdwx(k,j) + gg(k) &
- + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
- + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwx(k,i)= gvdwx(k,i) - gg(k)*sss_ele_cut &
+ + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss_ele_cut
+ gvdwx(k,j)= gvdwx(k,j) + gg(k)*sss_ele_cut &
+ + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss_ele_cut
!c! this acts on Calpha
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- 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
eom12 = 0.0d0
DO istate = 1, nstate(itypi,itypj)
!c*************************************************************
- IF (istate.ne.1) THEN
- IF (istate.lt.3) THEN
- ii = 1
- ELSE
- ii = 2
- END IF
- jj = istate/ii
- d1 = dhead(1,ii,itypi,itypj)
- d2 = dhead(2,jj,itypi,itypj)
- DO k = 1,3
- chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
- END DO
+ IF (istate.ne.1) THEN
+ IF (istate.lt.3) THEN
+ ii = 1
+ ELSE
+ ii = 2
+ END IF
+ jj = istate/ii
+ d1 = dhead(1,ii,itypi,itypj)
+ d2 = dhead(2,jj,itypi,itypj)
+ do k=1,3
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
+! 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)))
- END IF
- Rhead_sq = Rhead * Rhead
+! Rhead = dsqrt( &
+! (Rhead_distance(1)*Rhead_distance(1)) &
+! + (Rhead_distance(2)*Rhead_distance(2)) &
+! + (Rhead_distance(3)*Rhead_distance(3)))
+ END IF
+ Rhead_sq = Rhead * Rhead
!c! R1 - distance between head of ith side chain and tail of jth sidechain
!c! R2 - distance between head of jth side chain and tail of ith sidechain
- R1 = 0.0d0
- R2 = 0.0d0
- DO k = 1, 3
+ R1 = 0.0d0
+ R2 = 0.0d0
+ DO k = 1, 3
!c! Calculate head-to-tail distances
- R1=R1+(ctail(k,2)-chead(k,1))**2
- R2=R2+(chead(k,2)-ctail(k,1))**2
- END DO
+ R1=R1+(ctail(k,2)-chead(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
+ END DO
!c! Pitagoras
- R1 = dsqrt(R1)
- R2 = dsqrt(R2)
- Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
+ R1 = dsqrt(R1)
+ R2 = dsqrt(R2)
+ Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
!c! Ecl = 0.0d0
!c! write (*,*) "Ecl = ", Ecl
!c! derivative of Ecl is Gcl...
- dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
+ dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
!c! dGCLdR = 0.0d0
- dGCLdOM1 = 0.0d0
- dGCLdOM2 = 0.0d0
- dGCLdOM12 = 0.0d0
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
!c!-------------------------------------------------------------------
!c! Generalised Born Solvent Polarization
- ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
- Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
- Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
+ ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
+ Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
+ Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
!c! Egb = 0.0d0
!c! write (*,*) "a1*a2 = ", a12sq
!c! write (*,*) "Rhead = ", Rhead
!c! write (*,*) "Egb = ", Egb
!c! Derivative of Egb is Ggb...
!c! dFGBdR is used by Quad's later...
- dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
- dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
- / ( 2.0d0 * Fgb )
- dGGBdR = dGGBdFGB * dFGBdR
+ dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
+ dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
+ / ( 2.0d0 * Fgb )
+ dGGBdR = dGGBdFGB * dFGBdR
!c! dGGBdR = 0.0d0
!c!-------------------------------------------------------------------
!c! Fisocav - isotropic cavity creation term
- pom = Rhead * csig
- top = al1 * (dsqrt(pom) + al2 * pom - al3)
- bot = (1.0d0 + al4 * pom**12.0d0)
- botsq = bot * bot
- FisoCav = top / bot
- dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
- dbot = 12.0d0 * al4 * pom ** 11.0d0
- dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
+ pom = Rhead * csig
+ top = al1 * (dsqrt(pom) + al2 * pom - al3)
+ bot = (1.0d0 + al4 * pom**12.0d0)
+ botsq = bot * bot
+ FisoCav = top / bot
+ dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
+ dbot = 12.0d0 * al4 * pom ** 11.0d0
+ dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
+
!c! dGCVdR = 0.0d0
!c!-------------------------------------------------------------------
!c! Polarization energy
!c! Epol
- MomoFac1 = (1.0d0 - chi1 * sqom2)
- MomoFac2 = (1.0d0 - chi2 * sqom1)
- RR1 = ( R1 * R1 ) / MomoFac1
- RR2 = ( R2 * R2 ) / MomoFac2
- ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
- ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
- fgb1 = sqrt( RR1 + a12sq * ee1 )
- fgb2 = sqrt( RR2 + a12sq * ee2 )
- epol = 332.0d0 * eps_inout_fac * (&
- (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
+ MomoFac1 = (1.0d0 - chi1 * sqom2)
+ MomoFac2 = (1.0d0 - chi2 * sqom1)
+ RR1 = ( R1 * R1 ) / MomoFac1
+ RR2 = ( R2 * R2 ) / MomoFac2
+ ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
+ ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
+ fgb1 = sqrt( RR1 + a12sq * ee1 )
+ fgb2 = sqrt( RR2 + a12sq * ee2 )
+ epol = 332.0d0 * eps_inout_fac * (&
+ (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
!c! epol = 0.0d0
!c! derivative of Epol is Gpol...
- dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
- / (fgb1 ** 5.0d0)
- dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
- / (fgb2 ** 5.0d0)
- dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) )&
- / ( 2.0d0 * fgb1 )
- dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / ( 2.0d0 * fgb2 )
- dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * ( 2.0d0 - 0.5d0 * ee1) ) &
- / ( 2.0d0 * fgb1 )
- dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * ( 2.0d0 - 0.5d0 * ee2) ) &
- / ( 2.0d0 * fgb2 )
- dPOLdR1 = dPOLdFGB1 * dFGBdR1
+ dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
+ / (fgb1 ** 5.0d0)
+ dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
+ / (fgb2 ** 5.0d0)
+ dFGBdR1 = ( (R1 / MomoFac1) &
+ * ( 2.0d0 - (0.5d0 * ee1) ) )&
+ / ( 2.0d0 * fgb1 )
+ dFGBdR2 = ( (R2 / MomoFac2) &
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / ( 2.0d0 * fgb2 )
+ dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
+ * ( 2.0d0 - 0.5d0 * ee1) ) &
+ / ( 2.0d0 * fgb1 )
+ dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
+ * ( 2.0d0 - 0.5d0 * ee2) ) &
+ / ( 2.0d0 * fgb2 )
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1
!c! dPOLdR1 = 0.0d0
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2
!c! dPOLdR2 = 0.0d0
- dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
+ dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 0.0d0
- dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
- pom = (pis / Rhead)**6.0d0
- Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
+ dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
+ pom = (pis / Rhead)**6.0d0
+ Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! Elj = 0.0d0
!c! derivative of Elj is Glj
- dGLJdR = 4.0d0 * eps_head &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ dGLJdR = 4.0d0 * eps_head &
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
!c! dGLJdR = 0.0d0
!c!-------------------------------------------------------------------
!c! Equad
IF (Wqd.ne.0.0d0) THEN
- Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
- - 37.5d0 * ( sqom1 + sqom2 ) &
- + 157.5d0 * ( sqom1 * sqom2 ) &
- - 45.0d0 * om1*om2*om12
- fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
- Equad = fac * Beta1
+ Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
+ - 37.5d0 * ( sqom1 + sqom2 ) &
+ + 157.5d0 * ( sqom1 * sqom2 ) &
+ - 45.0d0 * om1*om2*om12
+ fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
+ Equad = fac * Beta1
!c! Equad = 0.0d0
!c! derivative of Equad...
- dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
+ dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
!c! dQUADdR = 0.0d0
- dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
+ dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
!c! dQUADdOM1 = 0.0d0
- dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
+ dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
!c! dQUADdOM2 = 0.0d0
- dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
+ dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
ELSE
- Beta1 = 0.0d0
- Equad = 0.0d0
- END IF
+ Beta1 = 0.0d0
+ Equad = 0.0d0
+ END IF
!c!-------------------------------------------------------------------
!c! Return the results
!c! Angular stuff
- eom1 = dPOLdOM1 + dQUADdOM1
- eom2 = dPOLdOM2 + dQUADdOM2
- eom12 = dQUADdOM12
+ eom1 = dPOLdOM1 + dQUADdOM1
+ eom2 = dPOLdOM2 + dQUADdOM2
+ eom12 = dQUADdOM12
!c! now some magical transformations to project gradient into
!c! three cartesian vectors
- DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
- tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
- END DO
+ DO k = 1, 3
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ END DO
!c! Radial stuff
- DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
- END DO
- erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
- erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
- bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
- federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
- eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
- adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
- facd1 = d1 * vbld_inv(i+nres)
- facd2 = d2 * vbld_inv(j+nres)
- facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
- facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
- DO k = 1, 3
- hawk = erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
- condor = erhead_tail(k,2) + &
- facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
-
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ DO k = 1, 3
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ END DO
+ erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+ erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
+ bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
+ federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ facd1 = d1 * vbld_inv(i+nres)
+ facd2 = d2 * vbld_inv(j+nres)
+ facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
+ facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
+ DO k = 1, 3
+ hawk = erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
+ condor = erhead_tail(k,2) + &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
!c! this acts on hydrophobic center of interaction
- gheadtail(k,1,1) = gheadtail(k,1,1) &
- - dGCLdR * pom &
- - dGGBdR * pom &
- - dGCVdR * pom &
- - dPOLdR1 * hawk &
- - dPOLdR2 * (erhead_tail(k,2) &
+! sgrad=sss_ele_grad*(Ecl+Egb+FisoCav+epol+Elj)*rij*rreal(k)
+ gheadtail(k,1,1) = gheadtail(k,1,1) &
+ - dGCLdR * pom &
+ - dGGBdR * pom &
+ - dGCVdR * pom &
+ - dPOLdR1 * hawk &
+ - dPOLdR2 * (erhead_tail(k,2) &
-facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
- - dGLJdR * pom &
- - dQUADdR * pom&
- - tuna(k) &
- + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ - dGLJdR * pom &
+ - dQUADdR * pom&
+ - tuna(k) &
+ + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss_ele_cut
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
!c! this acts on hydrophobic center of interaction
- gheadtail(k,2,1) = gheadtail(k,2,1) &
- + dGCLdR * pom &
- + dGGBdR * pom &
- + dGCVdR * pom &
- + dPOLdR1 * (erhead_tail(k,1) &
+ gheadtail(k,2,1) = gheadtail(k,2,1) &
+ + dGCLdR * pom &
+ + dGGBdR * pom &
+ + dGCVdR * pom &
+ + dPOLdR1 * (erhead_tail(k,1) &
-facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
- + dPOLdR2 * condor &
- + dGLJdR * pom &
- + dQUADdR * pom &
- + tuna(k) &
- + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ + dPOLdR2 * condor &
+ + dGLJdR * pom &
+ + dQUADdR * pom &
+ + tuna(k) &
+ + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss_ele_cut
!c! this acts on Calpha
- gheadtail(k,3,1) = gheadtail(k,3,1) &
- - dGCLdR * erhead(k)&
- - dGGBdR * erhead(k)&
- - dGCVdR * erhead(k)&
- - dPOLdR1 * erhead_tail(k,1)&
- - dPOLdR2 * erhead_tail(k,2)&
- - dGLJdR * erhead(k) &
- - dQUADdR * erhead(k)&
- - tuna(k)
+ gheadtail(k,3,1) = gheadtail(k,3,1) &
+ - dGCLdR * erhead(k)&
+ - dGGBdR * erhead(k)&
+ - dGCVdR * erhead(k)&
+ - dPOLdR1 * erhead_tail(k,1)&
+ - dPOLdR2 * erhead_tail(k,2)&
+ - dGLJdR * erhead(k) &
+ - dQUADdR * erhead(k)&
+ - tuna(k)
!c! this acts on Calpha
- gheadtail(k,4,1) = gheadtail(k,4,1) &
- + dGCLdR * erhead(k) &
- + dGGBdR * erhead(k) &
- + dGCVdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1) &
- + dPOLdR2 * erhead_tail(k,2) &
- + dGLJdR * erhead(k) &
- + dQUADdR * erhead(k)&
- + tuna(k)
- END DO
- ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
- eheadtail = eheadtail &
- + wstate(istate, itypi, itypj) &
- * dexp(-betaT * ener(istate))
+ gheadtail(k,4,1) = gheadtail(k,4,1) &
+ + dGCLdR * erhead(k) &
+ + dGGBdR * erhead(k) &
+ + dGCVdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k) &
+ + dQUADdR * erhead(k)&
+ + tuna(k)
+ END DO
+ ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
+ eheadtail = eheadtail &
+ + wstate(istate, itypi, itypj) &
+ * dexp(-betaT * ener(istate))
!c! foreach cartesian dimension
- DO k = 1, 3
+ DO k = 1, 3
!c! foreach of two gvdwx and gvdwc
- DO l = 1, 4
- gheadtail(k,l,2) = gheadtail(k,l,2) &
- + wstate( istate, itypi, itypj ) &
- * dexp(-betaT * ener(istate)) &
- * gheadtail(k,l,1)
- gheadtail(k,l,1) = 0.0d0
- END DO
- END DO
+ DO l = 1, 4
+ gheadtail(k,l,2) = gheadtail(k,l,2) &
+ + wstate( istate, itypi, itypj ) &
+ * dexp(-betaT * ener(istate)) &
+ * gheadtail(k,l,1)
+ gheadtail(k,l,1) = 0.0d0
+ END DO
+ END DO
END DO
!c! Here ended the gigantic DO istate = 1, 4, which starts
!c! at the beggining of the subroutine
DO k = 1, 3
- DO l = 1, 4
- gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
- END DO
- gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
- gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
- gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
- gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
- DO l = 1, 4
- gheadtail(k,l,1) = 0.0d0
- gheadtail(k,l,2) = 0.0d0
- END DO
+ DO l = 1, 4
+ gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
+ END DO
+ gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)*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
R1 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R1=R1+(ctail(k,2)-chead(k,1))**2
+ R1=R1+(ctail(k,2)-chead(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
fgb1 = sqrt( RR1 + a12sq * ee1)
epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
- dPOLdR1 = dPOLdFGB1 * dFGBdR1
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut
+! epol=epol*sss_ele_cut
!c! dPOLdR1 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
DO k = 1, 3
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
END DO
bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
- gvdwx(k,i) = gvdwx(k,i) &
- - dPOLdR1 * hawk
- gvdwx(k,j) = gvdwx(k,j) &
- + dPOLdR1 * (erhead_tail(k,1) &
- -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dPOLdR1 * hawk-epol*sss_ele_grad*rreal(k)*rij
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dPOLdR1 * (erhead_tail(k,1) &
+ -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
+ +epol*sss_ele_grad*rreal(k)*rij
- 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
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R2 = dsqrt(R2)
fgb2 = sqrt(RR2 + a12sq * ee2)
epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / (2.0d0 * fgb2)
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * (2.0d0 - 0.5d0 * ee2) ) &
- / (2.0d0 * fgb2)
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut
+! epol=epol*sss_ele_cut
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 0.0d0
!c! Return the results
!c! (See comments in Eqq)
DO k = 1, 3
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
facd2 = d2 * vbld_inv(j+nres)
facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
DO k = 1, 3
- condor = (erhead_tail(k,2) &
+ condor = (erhead_tail(k,2) &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
- gvdwx(k,i) = gvdwx(k,i) &
- - dPOLdR2 * (erhead_tail(k,2) &
- -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
- gvdwx(k,j) = gvdwx(k,j) &
- + dPOLdR2 * condor
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dPOLdR2 * (erhead_tail(k,2) &
+ -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
+ -epol*sss_ele_grad*rreal(k)*rij
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dPOLdR2 * condor+epol*sss_ele_grad*rreal(k)*rij
+
+
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dPOLdR2 * erhead_tail(k,2)-epol*sss_ele_grad*rreal(k)*rij
+
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dPOLdR2 * erhead_tail(k,2)+epol*sss_ele_grad*rreal(k)*rij
- gvdwc(k,i) = gvdwc(k,i) &
- - dPOLdR2 * erhead_tail(k,2)
- gvdwc(k,j) = gvdwc(k,j) &
- + dPOLdR2 * erhead_tail(k,2)
END DO
RETURN
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
!c! Calculate head-to-tail distances
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R2 = dsqrt(R2)
fgb2 = sqrt(RR2 + a12sq * ee2)
epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / (2.0d0 * fgb2)
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * (2.0d0 - 0.5d0 * ee2) ) &
- / (2.0d0 * fgb2)
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut+epol*sss_ele_grad
+ epol=epol*sss_ele_cut
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 0.0d0
!c! Return the results
!c! (See comments in Eqq)
DO k = 1, 3
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
facd2 = d2 * vbld_inv(j+nres)
facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
DO k = 1, 3
- condor = (erhead_tail(k,2) &
+ condor = (erhead_tail(k,2) &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
- gradpepcatx(k,i) = gradpepcatx(k,i) &
- - dPOLdR2 * (erhead_tail(k,2) &
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - dPOLdR2 * (erhead_tail(k,2) &
-facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
! gradpepcatx(k,j) = gradpepcatx(k,j) &
! + dPOLdR2 * condor
- gradpepcat(k,i) = gradpepcat(k,i) &
- - dPOLdR2 * erhead_tail(k,2)
- gradpepcat(k,j) = gradpepcat(k,j) &
- + dPOLdR2 * erhead_tail(k,2)
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - dPOLdR2 * erhead_tail(k,2)
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dPOLdR2 * erhead_tail(k,2)
END DO
RETURN
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)
R1 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R1=R1+(ctail(k,2)-chead(k,1))**2
+ R1=R1+(ctail(k,2)-chead(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
sparrow = w1 * Qi * om1
hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
Ecl = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
- dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ - hawk / Rhead**4.0d0
+ dGCLdR = (- 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
!c!------------------------------------------------------------------
!c! derivative of Epol is Gpol...
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
- dPOLdR1 = dPOLdFGB1 * dFGBdR1
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut
!c! dPOLdR1 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))*sss_ele_cut
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
-
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx(k,i) = gvdwx(k,i) &
- - dGCLdR * pom&
- - dPOLdR1 * hawk &
- - dGLJdR * pom
-
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx(k,j) = gvdwx(k,j) &
- + dGCLdR * pom &
- + dPOLdR1 * (erhead_tail(k,1) &
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ sgrad=(epol+elj+ecl)*sss_ele_grad*rreal(k)*rij
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dGCLdR * pom&
+ - dPOLdR1 * hawk &
+ - dGLJdR * pom &
+ -sgrad
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dGCLdR * pom &
+ + dPOLdR1 * (erhead_tail(k,1) &
-facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
- + dGLJdR * pom
+ + dGLJdR * pom+sgrad
- gvdwc(k,i) = gvdwc(k,i) &
- - dGCLdR * erhead(k) &
- - dPOLdR1 * erhead_tail(k,1) &
- - dGLJdR * erhead(k)
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1) &
+ - dGLJdR * erhead(k)-sgrad
- gvdwc(k,j) = gvdwc(k,j) &
- + dGCLdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1) &
- + dGLJdR * erhead(k)
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dGLJdR * erhead(k)+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)
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R2 = dsqrt(R2)
sparrow = w1 * Qj * om1
hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
ECL = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
- dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ 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
fgb2 = sqrt(RR2 + a12sq * ee2)
epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / (2.0d0 * fgb2)
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * (2.0d0 - 0.5d0 * ee2) ) &
- / (2.0d0 * fgb2)
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 0.0d0
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))*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)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
facd2 = d2 * vbld_inv(j+nres)
facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
DO k = 1, 3
- condor = (erhead_tail(k,2) &
+ condor = (erhead_tail(k,2) &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
-
- 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) &
+ 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
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dGCLdR * pom &
+ + dPOLdR2 * condor &
+ + dGLJdR * pom+sgrad
- gvdwc(k,i) = gvdwc(k,i) &
- - dGCLdR * erhead(k) &
- - dPOLdR2 * erhead_tail(k,2) &
- - dGLJdR * erhead(k)
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k)-sgrad
- gvdwc(k,j) = gvdwc(k,j) &
- + dGCLdR * erhead(k) &
- + dPOLdR2 * erhead_tail(k,2) &
- + dGLJdR * erhead(k)
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + 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)
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R2 = dsqrt(R2)
!c!-------------------------------------------------------------------
!c! ecl
+! write(iout,*) "KURWA2",Rhead
sparrow = w1 * Qj * om1
hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
ECL = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
- dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ 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
fgb2 = sqrt(RR2 + a12sq * ee2)
epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / (2.0d0 * fgb2)
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * (2.0d0 - 0.5d0 * ee2) ) &
- / (2.0d0 * fgb2)
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut+epol*sss_ele_grad
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
+ epol=epol*sss_ele_cut
!c!-------------------------------------------------------------------
!c! Elj
pom = (pis / Rhead)**6.0d0
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))*sss_ele_cut+&
+ Elj*sss_ele_grad
+ Elj=Elj*sss_ele_cut
!c!-------------------------------------------------------------------
!c! Return the results
!c! (see comments in Eqq)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
erdxj = scalar( erhead(1), dC_norm(1,j) )
facd2 = d2 * vbld_inv(j)
facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
DO k = 1, 3
- condor = (erhead_tail(k,2) &
+ condor = (erhead_tail(k,2) &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gradpepcatx(k,i) = gradpepcatx(k,i) &
- - dGCLdR * pom &
- - dPOLdR2 * (erhead_tail(k,2) &
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gradpepcatx(k,i) = gradpepcatx(k,i) &
+ - dGCLdR * pom &
+ - dPOLdR2 * (erhead_tail(k,2) &
-facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
- - dGLJdR * pom
+ - dGLJdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
! gradpepcatx(k,j) = gradpepcatx(k,j) &
! + dGCLdR * pom &
! + dPOLdR2 * condor &
! + dGLJdR * pom
- gradpepcat(k,i) = gradpepcat(k,i) &
- - dGCLdR * erhead(k) &
- - dPOLdR2 * erhead_tail(k,2) &
- - dGLJdR * erhead(k)
+ gradpepcat(k,i) = gradpepcat(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k)
- gradpepcat(k,j) = gradpepcat(k,j) &
- + dGCLdR * erhead(k) &
- + dPOLdR2 * erhead_tail(k,2) &
- + dGLJdR * erhead(k)
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k)
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)
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R2 = dsqrt(R2)
!c! 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
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
- dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ dGCLdR = (- 2.0d0 * sparrow / Rhead**3.0d0 &
+ + 4.0d0 * hawk / Rhead**5.0d0)*sss_ele_cut+&
+ ECL*sss_ele_grad
+ ECL=ECL*sss_ele_cut
!c! dF/dom1
dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
!c! dF/dom2
fgb2 = sqrt(RR2 + a12sq * ee2)
epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / (2.0d0 * fgb2)
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * (2.0d0 - 0.5d0 * ee2) ) &
- / (2.0d0 * fgb2)
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut+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 &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ dGLJdR = 4.0d0 * eps_head*sss_ele_cut &
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))+Elj*sss_ele_grad
+ Elj=Elj*sss_ele_cut
!c!-------------------------------------------------------------------
!c! Return the results
!c! (see comments in Eqq)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ 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) )
+ erdxi = scalar( erhead(1), dC_norm(1,i) )
erdxj = scalar( erhead(1), dC_norm(1,j) )
eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
- adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i) )
facd1 = d1 * vbld_inv(i+1)/2.0
facd2 = d2 * vbld_inv(j)
- facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
+ facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+1)/2.0
DO k = 1, 3
- condor = (erhead_tail(k,2) &
+ 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))
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i))
! gradpepcatx(k,i) = gradpepcatx(k,i) &
! - dGCLdR * pom &
! - dPOLdR2 * (erhead_tail(k,2) &
! -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
! - dGLJdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
! gradpepcatx(k,j) = gradpepcatx(k,j) &
! + dGCLdR * pom &
! + dPOLdR2 * condor &
! + dGLJdR * pom
- gradpepcat(k,i) = gradpepcat(k,i) +0.5d0*( &
- - dGCLdR * erhead(k) &
- - dPOLdR2 * erhead_tail(k,2) &
- - dGLJdR * erhead(k))
- gradpepcat(k,i+1) = gradpepcat(k,i+1) +0.5d0*( &
- - dGCLdR * erhead(k) &
- - dPOLdR2 * erhead_tail(k,2) &
- - dGLJdR * erhead(k))
+ gradpepcat(k,i) = gradpepcat(k,i) +0.5d0*( &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k))
+ gradpepcat(k,i+1) = gradpepcat(k,i+1) +0.5d0*( &
+ - dGCLdR * erhead(k) &
+ - dPOLdR2 * erhead_tail(k,2) &
+ - dGLJdR * erhead(k))
- gradpepcat(k,j) = gradpepcat(k,j) &
- + dGCLdR * erhead(k) &
- + dPOLdR2 * erhead_tail(k,2) &
- + dGLJdR * erhead(k)
+ gradpepcat(k,j) = gradpepcat(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k)
END DO
RETURN
fac = (om12 - 3.0d0 * om1 * om2)
c1 = (w1 / (Rhead**3.0d0)) * fac
c2 = (w2 / Rhead ** 6.0d0) &
- * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
ECL = c1 - c2
!c! write (*,*) "w1 = ", w1
!c! write (*,*) "w2 = ", w2
!c! dECL/dr
c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
- * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
- dGCLdR = c1 - c2
+ * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
+ dGCLdR = (c1 - c2)*sss_ele_cut!+ECL*sss_ele_grad
!c! dECL/dom1
c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
+ * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
dGCLdOM1 = c1 - c2
!c! dECL/dom2
c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
dGCLdOM2 = c1 - c2
!c! dECL/dom12
c1 = w1 / (Rhead ** 3.0d0)
!c! Return the results
!c! (see comments in Eqq)
DO k= 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
+ erhead(k) = Rhead_distance(k)/Rhead
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
facd2 = d2 * vbld_inv(j+nres)
DO k = 1, 3
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx(k,i) = gvdwx(k,i) - dGCLdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx(k,j) = gvdwx(k,j) + dGCLdR * pom
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i)- dGCLdR * pom-(ecl*sss_ele_grad*Rreal(k)*rij)
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom+(ecl*sss_ele_grad*Rreal(k)*rij)
- 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
!c! tail location and distance calculations
Rtail = 0.0d0
DO k = 1, 3
- ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
- ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
+ ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
+ ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
END DO
!c! tail distances will be themselves usefull elswhere
!c1 (in Gcav, for example)
Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
Rtail = dsqrt( &
- (Rtail_distance(1)*Rtail_distance(1)) &
- + (Rtail_distance(2)*Rtail_distance(2)) &
- + (Rtail_distance(3)*Rtail_distance(3)))
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
!c!-------------------------------------------------------------------
!c! Calculate location and distance between polar heads
!c! distance between heads
!c! location of polar head is computed by taking hydrophobic centre
!c! and moving by a d1 * dc_norm vector
!c! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
!c! distance
!c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
!c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
!c! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!c!-------------------------------------------------------------------
!c! zero everything that should be zero'ed
Egb = 0.0d0
BetaT = 1.0d0 / (298.0d0 * Rb)
!c! Gay-berne var's
sig0ij = sigmacat( itypi,itypj )
- chi1 = chicat( itypi, itypj )
+ chi1 = chi1cat( itypi, itypj )
chi2 = 0.0d0
chi12 = 0.0d0
- chip1 = chippcat( itypi, itypj )
+ chip1 = chipp1cat( itypi, itypj )
chip2 = 0.0d0
chip12 = 0.0d0
!c! not used by momo potential, but needed by sc_angular which is shared
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)
!c! ai*aj from Fgb
- a12sq = rborncat(itypi,itypj) * rborncat(itypj,itypi)
+ a12sq = rborn1cat(itypi,itypj) * rborn2cat(itypi,itypj)
!c! a12sq = a12sq * a12sq
!c! charge of amino acid itypi is...
Qi = icharge(itypi)
Qj = ichargecat(itypj)
Qij = Qi * Qj
!c! chis1,2,12
- chis1 = chiscat(itypi,itypj)
+ chis1 = chis1cat(itypi,itypj)
chis2 = 0.0d0
chis12 = 0.0d0
sig1 = sigmap1cat(itypi,itypj)
!c! tail location and distance calculations
Rtail = 0.0d0
DO k = 1, 3
- ctail(k,1)=c(k,i+nres)-dtailcat(1,itypi,itypj)*dc_norm(k,nres+i)
- ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
+ ctail(k,1)=c(k,i+nres)-dtailcat(1,itypi,itypj)*dc_norm(k,nres+i)
+ ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
END DO
!c! tail distances will be themselves usefull elswhere
!c1 (in Gcav, for example)
Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
Rtail = dsqrt( &
- (Rtail_distance(1)*Rtail_distance(1)) &
- + (Rtail_distance(2)*Rtail_distance(2)) &
- + (Rtail_distance(3)*Rtail_distance(3)))
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
!c!-------------------------------------------------------------------
!c! Calculate location and distance between polar heads
!c! distance between heads
!c! location of polar head is computed by taking hydrophobic centre
!c! and moving by a d1 * dc_norm vector
!c! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
- chead(k,2) = c(k, j)
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j)
!c! distance
!c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
!c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
!c! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!c!-------------------------------------------------------------------
!c! zero everything that should be zero'ed
Egb = 0.0d0
BetaT = 1.0d0 / (298.0d0 * Rb)
!c! Gay-berne var's
sig0ij = sigmacat( itypi,itypj )
- chi1 = chicat( itypi, itypj )
+ chi1 = chi1cat( itypi, itypj )
chi2 = 0.0d0
chi12 = 0.0d0
- chip1 = chippcat( itypi, itypj )
+ chip1 = chipp1cat( itypi, itypj )
chip2 = 0.0d0
chip12 = 0.0d0
!c! not used by momo potential, but needed by sc_angular which is shared
d1 = dheadcat(1, 1, itypi, itypj)
d2 = dheadcat(2, 1, itypi, itypj)
!c! ai*aj from Fgb
- a12sq = rborncat(itypi,itypj) * rborncat(itypj,itypi)
+ a12sq = rborn1cat(itypi,itypj) * rborn2cat(itypi,itypj)
!c! a12sq = a12sq * a12sq
!c! charge of amino acid itypi is...
Qi = 0
Qj = ichargecat(itypj)
! Qij = Qi * Qj
!c! chis1,2,12
- chis1 = chiscat(itypi,itypj)
+ chis1 = chis1cat(itypi,itypj)
chis2 = 0.0d0
chis12 = 0.0d0
sig1 = sigmap1cat(itypi,itypj)
!c! tail location and distance calculations
Rtail = 0.0d0
DO k = 1, 3
- ctail(k,1)=(c(k,i)+c(k,i+1))/2.0-dtailcat(1,itypi,itypj)*dc_norm(k,i)
- ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
+ ctail(k,1)=(c(k,i)+c(k,i+1))/2.0-dtailcat(1,itypi,itypj)*dc_norm(k,i)
+ ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
END DO
!c! tail distances will be themselves usefull elswhere
!c1 (in Gcav, for example)
Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
Rtail = dsqrt( &
- (Rtail_distance(1)*Rtail_distance(1)) &
- + (Rtail_distance(2)*Rtail_distance(2)) &
- + (Rtail_distance(3)*Rtail_distance(3)))
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
!c!-------------------------------------------------------------------
!c! Calculate location and distance between polar heads
!c! distance between heads
!c! location of polar head is computed by taking hydrophobic centre
!c! and moving by a d1 * dc_norm vector
!c! see unres publications for very informative images
- chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
- chead(k,2) = c(k, j)
+ chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
+ chead(k,2) = c(k, j)
!c! distance
!c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
!c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
!c! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!c!-------------------------------------------------------------------
!c! zero everything that should be zero'ed
Egb = 0.0d0
yy(0)=1.0d0
yy(1)=y
do i=2,n
- yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
+ yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
enddo
aux=0.0d0
do i=m,n
- aux=aux+x(i)*yy(i)
+ aux=aux+x(i)*yy(i)
enddo
tschebyshev=aux
return
yy(0)=1.0d0
yy(1)=2.0d0*y
do i=2,n
- yy(i)=2*y*yy(i-1)-yy(i-2)
+ yy(i)=2*y*yy(i-1)-yy(i-2)
enddo
aux=0.0d0
do i=m,n
- aux=aux+x(i+1)*yy(i)*(i+1)
+ aux=aux+x(i+1)*yy(i)*(i+1)
!C print *, x(i+1),yy(i),i
enddo
gradtschebyshev=aux
return
end function gradtschebyshev
+!!!!!!!!!--------------------------------------------------------------
+ subroutine lipid_bond(elipbond)
+ real(kind=8) :: elipbond,fac,dist_sub,sumdist
+ real(kind=8), dimension(3):: dist
+ integer(kind=8) :: i,j,k,ibra,ityp,jtyp,ityp1
+ elipbond=0.0d0
+! print *,"before",ilipbond_start,ilipbond_end
+ do i=ilipbond_start,ilipbond_end
+! print *,i,i+1,"i,i+1"
+ ityp=itype(i,4)
+ ityp1=itype(i+1,4)
+! print *,ityp,ityp1,"itype"
+ j=i+1
+ if (ityp.eq.12) ibra=i
+ if ((ityp.eq.ntyp1_molec(4)).or.(ityp1.ge.ntyp1_molec(4)-1)) cycle
+ if (ityp.eq.(ntyp1_molec(4)-1)) then
+ !cofniecie do ostatnie GL1
+! i=ibra
+ j=ibra
+ else
+ 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
+ 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
+ contlisti(ilist_sc)=i
+ contlistj(ilist_sc)=j
+
+ endif
+ enddo
+ enddo
+ enddo
+! call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
+! MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! call MPI_Gather(newnss,1,MPI_INTEGER,&
+! i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_sc
+ do i=1,ilist_sc
+ write (iout,*) i,contlisti(i),contlistj(i)
+ enddo
+#endif
+ if (nfgtasks.gt.1)then
+
+ call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_sc,1,MPI_INTEGER,&
+ i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_sc(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,&
+ newcontlisti,i_ilist_sc,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,&
+ newcontlistj,i_ilist_sc,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,IERR)
+
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+
+ else
+ g_ilist_sc=ilist_sc
+
+ do i=1,ilist_sc
+ newcontlisti(i)=contlisti(i)
+ newcontlistj(i)=contlistj(i)
+ enddo
+ endif
+
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",g_ilist_sc
+ do i=1,g_ilist_sc
+ write (iout,*) i,newcontlisti(i),newcontlistj(i)
+ enddo
+#endif
+ call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end)
+ return
+ end subroutine make_SCSC_inter_list
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ subroutine make_SCp_inter_list
+ use MD_data, only: itime_mat
+
+ include 'mpif.h'
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real(kind=8) :: dist_init, dist_temp,r_buff_list
+ integer:: contlistscpi(350*nres),contlistscpj(350*nres)
+! integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_scp,g_ilist_scp
+ integer displ(0:nprocs),i_ilist_scp(0:nprocs),ierr
+! print *,"START make_SC"
+ r_buff_list=5.0
+ ilist_scp=0
+ do i=iatscp_s,iatscp_e
+ if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
+ xi=0.5D0*(c(1,i)+c(1,i+1))
+ yi=0.5D0*(c(2,i)+c(2,i+1))
+ zi=0.5D0*(c(3,i)+c(3,i+1))
+ call to_box(xi,yi,zi)
+ do iint=1,nscp_gr(i)
+
+ do j=iscpstart(i,iint),iscpend(i,iint)
+ itypj=iabs(itype(j,1))
+ if (itypj.eq.ntyp1) cycle
+! Uncomment following three lines for SC-p interactions
+! xj=c(1,nres+j)-xi
+! yj=c(2,nres+j)-yi
+! zj=c(3,nres+j)-zi
+! Uncomment following three lines for Ca-p interactions
+! xj=c(1,j)-xi
+! yj=c(2,j)-yi
+! zj=c(3,j)-zi
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+#ifdef DEBUG
+ ! r_buff_list is a read value for a buffer
+ if ((sqrt(dist_init).le.(r_cut_ele)).and.(ifirstrun.eq.0)) then
+! Here the list is created
+ ilist_scp_first=ilist_scp_first+1
+! this can be substituted by cantor and anti-cantor
+ contlistscpi_f(ilist_scp_first)=i
+ contlistscpj_f(ilist_scp_first)=j
+ endif
+#endif
+! r_buff_list is a read value for a buffer
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ ilist_scp=ilist_scp+1
+! this can be substituted by cantor and anti-cantor
+ contlistscpi(ilist_scp)=i
+ contlistscpj(ilist_scp)=j
+ endif
+ enddo
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_scp
+ do i=1,ilist_scp
+ write (iout,*) i,contlistscpi(i),contlistscpj(i)
+ enddo
+#endif
+ if (nfgtasks.gt.1)then
+
+ call MPI_Reduce(ilist_scp,g_ilist_scp,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_scp,1,MPI_INTEGER,&
+ i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_scp(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,&
+ newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,&
+ newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,IERR)
+
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+
+ else
+ g_ilist_scp=ilist_scp
+
+ do i=1,ilist_scp
+ newcontlistscpi(i)=contlistscpi(i)
+ newcontlistscpj(i)=contlistscpj(i)
+ enddo
+ endif
+
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",g_ilist_scp
+ do i=1,g_ilist_scp
+ write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
+ enddo
+
+! if (ifirstrun.eq.0) ifirstrun=1
+! do i=1,ilist_scp_first
+! do j=1,g_ilist_scp
+! if ((newcontlistscpi(j).eq.contlistscpi_f(i)).and.&
+! (newcontlistscpj(j).eq.contlistscpj_f(i))) go to 126
+! enddo
+! print *,itime_mat,"ERROR matrix needs updating"
+! print *,contlistscpi_f(i),contlistscpj_f(i)
+! 126 continue
+! enddo
+#endif
+ call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end)
+
+ return
+ end subroutine make_SCp_inter_list
+
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+
+
+ subroutine make_pp_inter_list
+ include 'mpif.h'
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real(kind=8) :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj
+ real(kind=8) :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi
+ real(kind=8) :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj
+ integer:: contlistppi(250*nres),contlistppj(250*nres)
+! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_pp,g_ilist_pp
+ integer displ(0:nprocs),i_ilist_pp(0:nprocs),ierr
+! write(iout,*),"START make_pp",iatel_s,iatel_e,r_cut_ele+r_buff_list
+ ilist_pp=0
+ r_buff_list=5.0
+ do i=iatel_s,iatel_e
+ if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
+ dxi=dc(1,i)
+ dyi=dc(2,i)
+ dzi=dc(3,i)
+ dx_normi=dc_norm(1,i)
+ dy_normi=dc_norm(2,i)
+ dz_normi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+! write (iout,*) i,j,itype(i,1),itype(j,1)
+! if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
+
+! 1,j)
+ do j=ielstart(i),ielend(i)
+! write (iout,*) i,j,itype(i,1),itype(j,1)
+ if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
+ dx_normj=dc_norm(1,j)
+ dy_normj=dc_norm(2,j)
+ dz_normj=dc_norm(3,j)
+! xj=c(1,j)+0.5D0*dxj-xmedi
+! yj=c(2,j)+0.5D0*dyj-ymedi
+! zj=c(3,j)+0.5D0*dzj-zmedi
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ call to_box(xj,yj,zj)
+! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
+! Here the list is created
+ ilist_pp=ilist_pp+1
+! this can be substituted by cantor and anti-cantor
+ contlistppi(ilist_pp)=i
+ contlistppj(ilist_pp)=j
+ endif
+! enddo
+ enddo
+ enddo
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE",ilist_pp
+ do i=1,ilist_pp
+ write (iout,*) i,contlistppi(i),contlistppj(i)
+ enddo
+#endif
+ if (nfgtasks.gt.1)then
+
+ call MPI_Reduce(ilist_pp,g_ilist_pp,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+ call MPI_Gather(ilist_pp,1,MPI_INTEGER,&
+ i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_pp(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER,&
+ newcontlistppi,i_ilist_pp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER,&
+ newcontlistppj,i_ilist_pp,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_pp,1,MPI_INT,king,FG_COMM,IERR)
+! write(iout,*) "before bcast",g_ilist_sc
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM,IERR)
+ call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM,IERR)
+
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+
+ else
+ g_ilist_pp=ilist_pp
+
+ do i=1,ilist_pp
+ newcontlistppi(i)=contlistppi(i)
+ newcontlistppj(i)=contlistppj(i)
+ enddo
+ endif
+ call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end)
+#ifdef DEBUG
+ write (iout,*) "after MPIREDUCE",g_ilist_pp
+ do i=1,g_ilist_pp
+ write (iout,*) i,newcontlistppi(i),newcontlistppj(i)
+ enddo
+#endif
+ return
+ end subroutine make_pp_inter_list
+!---------------------------------------------------------------------------
+ subroutine make_cat_pep_list
+ include 'mpif.h'
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
+ real(kind=8) :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj
+ real(kind=8) :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi
+ real(kind=8) :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj
+ real(kind=8) :: xja,yja,zja
+ integer:: contlistcatpnormi(300*nres),contlistcatpnormj(300*nres)
+ integer:: contlistcatscnormi(250*nres),contlistcatscnormj(250*nres)
+ integer:: contlistcatptrani(250*nres),contlistcatptranj(250*nres)
+ integer:: contlistcatsctrani(250*nres),contlistcatsctranj(250*nres)
+ integer:: contlistcatscangi(250*nres),contlistcatscangj(250*nres)
+ integer:: contlistcatscangfi(250*nres),contlistcatscangfj(250*nres),&
+ contlistcatscangfk(250*nres)
+ integer:: contlistcatscangti(250*nres),contlistcatscangtj(250*nres)
+ integer:: contlistcatscangtk(250*nres),contlistcatscangtl(250*nres)
+
+
+! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_catscnorm,&
+ ilist_catsctran,ilist_catpnorm,ilist_catptran,itmp,ilist_catscang,&
+ ilist_catscangf,ilist_catscangt,k
+ integer displ(0:nprocs),i_ilist_catscnorm(0:nprocs),ierr,&
+ i_ilist_catpnorm(0:nprocs),i_ilist_catsctran(0:nprocs),&
+ i_ilist_catptran(0:nprocs),i_ilist_catscang(0:nprocs),&
+ i_ilist_catscangf(0:nprocs),i_ilist_catscangt(0:nprocs)
+! write(iout,*),"START make_pp",iatel_s,iatel_e,r_cut_ele+r_buff_list
+ ilist_catpnorm=0
+ ilist_catscnorm=0
+ ilist_catptran=0
+ ilist_catsctran=0
+ ilist_catscang=0
+
+
+ r_buff_list=6.0
+ itmp=0
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
+! go to 17
+! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
+ do i=ibond_start,ibond_end
+
+! 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,*) "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
+
+ 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
projects / unres4.git / blobdiff