- module energy
+ module energy
!-----------------------------------------------------------------------------
use io_units
use names
call MPI_Bcast(itime_mat,1,MPI_INT,king,FG_COMM,IERROR)
endif
if (mod(itime_mat,imatupdate).eq.0) call make_SCp_inter_list
+ write (iout,*) "after make_SCp_inter_list"
if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list
+ write (iout,*) "after make_SCSC_inter_list"
+
if (mod(itime_mat,imatupdate).eq.0) call make_pp_inter_list
+ write (iout,*) "after make_pp_inter_list"
! print *,'Processor',myrank,' calling etotal ipot=',ipot
! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
!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
!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
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
call to_box(xj,yj,zj)
xj=boxshift(xj-xi,boxxsize)
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)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+
!
! Calculate SC interaction energy.
!
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
+ call to_box(xj,yj,zj)
rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
fac_augm=rrij**expon
e_augm=augm(itypi,itypj)*fac_augm
! 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
!
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)
! 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
if (y.lt.ymin) then
gnmr1=(ymin-y)**wykl/wykl
else if (y.gt.ymax) then
- gnmr1=(y-ymax)**wykl/wykl
+ gnmr1=(y-ymax)**wykl/wykl
else
- gnmr1=0.0d0
+ gnmr1=0.0d0
endif
return
end function gnmr1
real(kind=8) :: y,ymin,ymax
real(kind=8) :: wykl=4.0d0
if (y.lt.ymin) then
- gnmr1prim=-(ymin-y)**(wykl-1)
+ gnmr1prim=-(ymin-y)**(wykl-1)
else if (y.gt.ymax) then
- gnmr1prim=(y-ymax)**(wykl-1)
+ gnmr1prim=(y-ymax)**(wykl-1)
else
- gnmr1prim=0.0d0
+ gnmr1prim=0.0d0
endif
return
end function gnmr1prim
if (y.lt.ymin) then
rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
else if (y.gt.ymax) then
- rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
+ rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
else
rlornmr1=0.0d0
endif
rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
((ymin-y)**wykl+sigma**wykl)**2
else if (y.gt.ymax) then
- rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
+ rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
((y-ymax)**wykl+sigma**wykl)**2
else
- rlornmr1prim=0.0d0
+ rlornmr1prim=0.0d0
endif
return
end function rlornmr1prim
gthetai=0.0D0
gphii=0.0D0
do j=i+1,nres-1
- ind=ind+1
+ ind=ind+1
! ind=indmat(i,j)
! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
- do k=1,3
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- enddo
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- enddo
+ do k=1,3
+ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
enddo
+ do 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
! 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
write (iout,*) "gcart and gxcart after int_to_cart"
do i=0,nres-1
write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
- (gxcart(j,i),j=1,3)
+ (gxcart(j,i),j=1,3)
enddo
#endif
!#undef DEBUG
if (nnt.gt.1) then
do j=1,3
! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
- gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
- enddo
- endif
- if (nct.lt.nres) then
- do j=1,3
+ gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
+ enddo
+ endif
+ if (nct.lt.nres) then
+ do j=1,3
! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
- gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
- enddo
- endif
+ gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
+ enddo
+ endif
#endif
#ifdef TIMING
- time_cartgrad=time_cartgrad+MPI_Wtime()-time00
+ time_cartgrad=time_cartgrad+MPI_Wtime()-time00
#endif
!#undef DEBUG
- return
- end subroutine cartgrad
+ return
+ end subroutine cartgrad
!-----------------------------------------------------------------------------
- subroutine zerograd
+ subroutine zerograd
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.DERIV'
! include 'COMMON.SCCOR'
!
!el local variables
- integer :: i,j,intertyp,k
+ integer :: i,j,intertyp,k
! Initialize Cartesian-coordinate gradient
!
! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
! common /mpgrad/
! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
-
-
+
+
! gradc(j,i,icg)=0.0d0
! gradx(j,i,icg)=0.0d0
! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
!elwrite(iout,*) "icg",icg
- do i=-1,nres
- do j=1,3
- gvdwx(j,i)=0.0D0
- gradx_scp(j,i)=0.0D0
- gvdwc(j,i)=0.0D0
- gvdwc_scp(j,i)=0.0D0
- gvdwc_scpp(j,i)=0.0d0
- gelc(j,i)=0.0D0
- gelc_long(j,i)=0.0D0
- gradb(j,i)=0.0d0
- gradbx(j,i)=0.0d0
- gvdwpp(j,i)=0.0d0
- gel_loc(j,i)=0.0d0
- gel_loc_long(j,i)=0.0d0
- ghpbc(j,i)=0.0D0
- ghpbx(j,i)=0.0D0
- gcorr3_turn(j,i)=0.0d0
- gcorr4_turn(j,i)=0.0d0
- gradcorr(j,i)=0.0d0
- gradcorr_long(j,i)=0.0d0
- gradcorr5_long(j,i)=0.0d0
- gradcorr6_long(j,i)=0.0d0
- gcorr6_turn_long(j,i)=0.0d0
- gradcorr5(j,i)=0.0d0
- gradcorr6(j,i)=0.0d0
- gcorr6_turn(j,i)=0.0d0
- gsccorc(j,i)=0.0d0
- gsccorx(j,i)=0.0d0
- gradc(j,i,icg)=0.0d0
- gradx(j,i,icg)=0.0d0
- gscloc(j,i)=0.0d0
- gsclocx(j,i)=0.0d0
- gliptran(j,i)=0.0d0
- gliptranx(j,i)=0.0d0
- gliptranc(j,i)=0.0d0
- gshieldx(j,i)=0.0d0
- gshieldc(j,i)=0.0d0
- gshieldc_loc(j,i)=0.0d0
- gshieldx_ec(j,i)=0.0d0
- gshieldc_ec(j,i)=0.0d0
- gshieldc_loc_ec(j,i)=0.0d0
- gshieldx_t3(j,i)=0.0d0
- gshieldc_t3(j,i)=0.0d0
- gshieldc_loc_t3(j,i)=0.0d0
- gshieldx_t4(j,i)=0.0d0
- gshieldc_t4(j,i)=0.0d0
- gshieldc_loc_t4(j,i)=0.0d0
- gshieldx_ll(j,i)=0.0d0
- gshieldc_ll(j,i)=0.0d0
- gshieldc_loc_ll(j,i)=0.0d0
- gg_tube(j,i)=0.0d0
- gg_tube_sc(j,i)=0.0d0
- gradafm(j,i)=0.0d0
- gradb_nucl(j,i)=0.0d0
- gradbx_nucl(j,i)=0.0d0
- gvdwpp_nucl(j,i)=0.0d0
- gvdwpp(j,i)=0.0d0
- gelpp(j,i)=0.0d0
- gvdwpsb(j,i)=0.0d0
- gvdwpsb1(j,i)=0.0d0
- gvdwsbc(j,i)=0.0d0
- gvdwsbx(j,i)=0.0d0
- gelsbc(j,i)=0.0d0
- gradcorr_nucl(j,i)=0.0d0
- gradcorr3_nucl(j,i)=0.0d0
- gradxorr_nucl(j,i)=0.0d0
- gradxorr3_nucl(j,i)=0.0d0
- gelsbx(j,i)=0.0d0
- gsbloc(j,i)=0.0d0
- gsblocx(j,i)=0.0d0
- gradpepcat(j,i)=0.0d0
- gradpepcatx(j,i)=0.0d0
- gradcatcat(j,i)=0.0d0
- gvdwx_scbase(j,i)=0.0d0
- gvdwc_scbase(j,i)=0.0d0
- gvdwx_pepbase(j,i)=0.0d0
- gvdwc_pepbase(j,i)=0.0d0
- gvdwx_scpho(j,i)=0.0d0
- gvdwc_scpho(j,i)=0.0d0
- gvdwc_peppho(j,i)=0.0d0
- enddo
- enddo
- do i=0,nres
- do j=1,3
- do intertyp=1,3
- gloc_sc(intertyp,i,icg)=0.0d0
- enddo
- enddo
+ do i=-1,nres
+ do j=1,3
+ gvdwx(j,i)=0.0D0
+ gradx_scp(j,i)=0.0D0
+ gvdwc(j,i)=0.0D0
+ gvdwc_scp(j,i)=0.0D0
+ gvdwc_scpp(j,i)=0.0d0
+ gelc(j,i)=0.0D0
+ gelc_long(j,i)=0.0D0
+ gradb(j,i)=0.0d0
+ gradbx(j,i)=0.0d0
+ gvdwpp(j,i)=0.0d0
+ gel_loc(j,i)=0.0d0
+ gel_loc_long(j,i)=0.0d0
+ ghpbc(j,i)=0.0D0
+ ghpbx(j,i)=0.0D0
+ gcorr3_turn(j,i)=0.0d0
+ gcorr4_turn(j,i)=0.0d0
+ gradcorr(j,i)=0.0d0
+ gradcorr_long(j,i)=0.0d0
+ gradcorr5_long(j,i)=0.0d0
+ gradcorr6_long(j,i)=0.0d0
+ gcorr6_turn_long(j,i)=0.0d0
+ gradcorr5(j,i)=0.0d0
+ gradcorr6(j,i)=0.0d0
+ gcorr6_turn(j,i)=0.0d0
+ gsccorc(j,i)=0.0d0
+ gsccorx(j,i)=0.0d0
+ gradc(j,i,icg)=0.0d0
+ gradx(j,i,icg)=0.0d0
+ gscloc(j,i)=0.0d0
+ gsclocx(j,i)=0.0d0
+ gliptran(j,i)=0.0d0
+ gliptranx(j,i)=0.0d0
+ gliptranc(j,i)=0.0d0
+ gshieldx(j,i)=0.0d0
+ gshieldc(j,i)=0.0d0
+ gshieldc_loc(j,i)=0.0d0
+ gshieldx_ec(j,i)=0.0d0
+ gshieldc_ec(j,i)=0.0d0
+ gshieldc_loc_ec(j,i)=0.0d0
+ gshieldx_t3(j,i)=0.0d0
+ gshieldc_t3(j,i)=0.0d0
+ gshieldc_loc_t3(j,i)=0.0d0
+ gshieldx_t4(j,i)=0.0d0
+ gshieldc_t4(j,i)=0.0d0
+ gshieldc_loc_t4(j,i)=0.0d0
+ gshieldx_ll(j,i)=0.0d0
+ gshieldc_ll(j,i)=0.0d0
+ gshieldc_loc_ll(j,i)=0.0d0
+ gg_tube(j,i)=0.0d0
+ gg_tube_sc(j,i)=0.0d0
+ gradafm(j,i)=0.0d0
+ gradb_nucl(j,i)=0.0d0
+ gradbx_nucl(j,i)=0.0d0
+ gvdwpp_nucl(j,i)=0.0d0
+ gvdwpp(j,i)=0.0d0
+ gelpp(j,i)=0.0d0
+ gvdwpsb(j,i)=0.0d0
+ gvdwpsb1(j,i)=0.0d0
+ gvdwsbc(j,i)=0.0d0
+ gvdwsbx(j,i)=0.0d0
+ gelsbc(j,i)=0.0d0
+ gradcorr_nucl(j,i)=0.0d0
+ gradcorr3_nucl(j,i)=0.0d0
+ gradxorr_nucl(j,i)=0.0d0
+ gradxorr3_nucl(j,i)=0.0d0
+ gelsbx(j,i)=0.0d0
+ gsbloc(j,i)=0.0d0
+ gsblocx(j,i)=0.0d0
+ gradpepcat(j,i)=0.0d0
+ gradpepcatx(j,i)=0.0d0
+ gradcatcat(j,i)=0.0d0
+ gvdwx_scbase(j,i)=0.0d0
+ gvdwc_scbase(j,i)=0.0d0
+ gvdwx_pepbase(j,i)=0.0d0
+ gvdwc_pepbase(j,i)=0.0d0
+ gvdwx_scpho(j,i)=0.0d0
+ gvdwc_scpho(j,i)=0.0d0
+ gvdwc_peppho(j,i)=0.0d0
+ enddo
+ enddo
+ do i=0,nres
+ do j=1,3
+ do intertyp=1,3
+ gloc_sc(intertyp,i,icg)=0.0d0
enddo
- do i=1,nres
- do j=1,maxcontsshi
- shield_list(j,i)=0
- do k=1,3
+ enddo
+ enddo
+ do i=1,nres
+ do j=1,maxcontsshi
+ shield_list(j,i)=0
+ do k=1,3
!C print *,i,j,k
- grad_shield_side(k,j,i)=0.0d0
- grad_shield_loc(k,j,i)=0.0d0
- enddo
- enddo
- ishield_list(i)=0
- enddo
+ grad_shield_side(k,j,i)=0.0d0
+ grad_shield_loc(k,j,i)=0.0d0
+ enddo
+ enddo
+ ishield_list(i)=0
+ enddo
!
! Initialize the gradient of local energy terms.
! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
! allocate(gsccor_loc(nres)) !(maxres)
- do i=1,4*nres
- gloc(i,icg)=0.0D0
- enddo
- do i=1,nres
- gel_loc_loc(i)=0.0d0
- gcorr_loc(i)=0.0d0
- g_corr5_loc(i)=0.0d0
- g_corr6_loc(i)=0.0d0
- gel_loc_turn3(i)=0.0d0
- gel_loc_turn4(i)=0.0d0
- gel_loc_turn6(i)=0.0d0
- gsccor_loc(i)=0.0d0
- enddo
+ do i=1,4*nres
+ gloc(i,icg)=0.0D0
+ enddo
+ do i=1,nres
+ gel_loc_loc(i)=0.0d0
+ gcorr_loc(i)=0.0d0
+ g_corr5_loc(i)=0.0d0
+ g_corr6_loc(i)=0.0d0
+ gel_loc_turn3(i)=0.0d0
+ gel_loc_turn4(i)=0.0d0
+ gel_loc_turn6(i)=0.0d0
+ gsccor_loc(i)=0.0d0
+ enddo
! initialize gcart and gxcart
! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
- do i=0,nres
- do j=1,3
- gcart(j,i)=0.0d0
- gxcart(j,i)=0.0d0
- enddo
- enddo
- return
- end subroutine zerograd
+ do i=0,nres
+ do j=1,3
+ gcart(j,i)=0.0d0
+ gxcart(j,i)=0.0d0
+ enddo
+ enddo
+ return
+ end subroutine zerograd
!-----------------------------------------------------------------------------
- real(kind=8) function fdum()
- fdum=0.0D0
- return
- end function fdum
+ real(kind=8) function fdum()
+ fdum=0.0D0
+ return
+ end function fdum
!-----------------------------------------------------------------------------
! intcartderiv.F
!-----------------------------------------------------------------------------
- subroutine intcartderiv
+ subroutine intcartderiv
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
- include 'mpif.h'
+ include 'mpif.h'
#endif
! include 'COMMON.SETUP'
! include 'COMMON.CHAIN'
! include 'COMMON.IOUNITS'
! include 'COMMON.LOCAL'
! include 'COMMON.SCCOR'
- real(kind=8) :: pi4,pi34
- real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
- real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
- dcosomega,dsinomega !(3,3,maxres)
- real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
-
- integer :: i,j,k
- real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
- fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
- fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
- fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
- integer :: nres2
- nres2=2*nres
+ real(kind=8) :: pi4,pi34
+ real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
+ real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
+ dcosomega,dsinomega !(3,3,maxres)
+ real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
+
+ integer :: i,j,k
+ real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
+ fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
+ fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
+ fac17,coso_inv,fac10,fac11,fac12,fac13,fac14,IERROR
+ integer :: nres2
+ nres2=2*nres
!el from module energy-------------
!el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
#if defined(MPI) && defined(PARINTDER)
- if (nfgtasks.gt.1 .and. me.eq.king) &
- call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
+ if (nfgtasks.gt.1 .and. me.eq.king) &
+ call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
#endif
- pi4 = 0.5d0*pipol
- pi34 = 3*pi4
+ pi4 = 0.5d0*pipol
+ pi34 = 3*pi4
! allocate(dtheta(3,2,nres)) !(3,2,maxres)
! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
- do i=1,nres
- do j=1,3
- dtheta(j,1,i)=0.0d0
- dtheta(j,2,i)=0.0d0
- dphi(j,1,i)=0.0d0
- dphi(j,2,i)=0.0d0
- dphi(j,3,i)=0.0d0
- 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
+ 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) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
+ dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
+ vbld(i)
+ if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
+ enddo
+ enddo
#if defined(MPI) && defined(PARINTDER)
! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
- do i=max0(ithet_start-1,3),ithet_end
+ 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).and.molnum(i).ne.5) then
- cost1=dcos(omicron(1,i))
- sint1=sqrt(1-cost1*cost1)
- cost2=dcos(omicron(2,i))
- sint2=sqrt(1-cost2*cost2)
- do j=1,3
+ if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1).and.molnum(i).ne.5) then
+ cost1=dcos(omicron(1,i))
+ sint1=sqrt(1-cost1*cost1)
+ cost2=dcos(omicron(2,i))
+ sint2=sqrt(1-cost2*cost2)
+ do j=1,3
!C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
- dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
- cost1*dc_norm(j,i-2))/ &
- vbld(i-1)
- domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i)
- dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
- +cost1*(dc_norm(j,i-1+nres)))/ &
- vbld(i-1+nres)
- domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i)
+ dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
+ cost1*dc_norm(j,i-2))/ &
+ vbld(i-1)
+ domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i)
+ dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
+ +cost1*(dc_norm(j,i-1+nres)))/ &
+ vbld(i-1+nres)
+ domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i)
!C Calculate derivative over second omicron Sci-1,Cai-1 Cai
!C Looks messy but better than if in loop
- dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
- +cost2*dc_norm(j,i-1))/ &
- vbld(i)
- domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i)
- dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
- +cost2*(-dc_norm(j,i-1+nres)))/ &
- vbld(i-1+nres)
+ dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
+ +cost2*dc_norm(j,i-1))/ &
+ vbld(i)
+ domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i)
+ dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
+ +cost2*(-dc_norm(j,i-1+nres)))/ &
+ vbld(i-1+nres)
! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
- domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i)
- enddo
- endif
- enddo
+ domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i)
+ enddo
+ endif
+ enddo
!elwrite(iout,*) "after vbld write"
! Derivatives of phi:
! If phi is 0 or 180 degrees, then the formulas
! have to be derived by power series expansion of the
! conventional formulas around 0 and 180.
#ifdef PARINTDER
- do i=iphi1_start,iphi1_end
+ do i=iphi1_start,iphi1_end
#else
- do i=4,nres
+ do i=4,nres
#endif
! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
! the conventional case
- sint=dsin(theta(i))
- sint1=dsin(theta(i-1))
- sing=dsin(phi(i))
- cost=dcos(theta(i))
- cost1=dcos(theta(i-1))
- cosg=dcos(phi(i))
- scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
+ sint=dsin(theta(i))
+ sint1=dsin(theta(i-1))
+ sing=dsin(phi(i))
+ cost=dcos(theta(i))
+ cost1=dcos(theta(i-1))
+ cosg=dcos(phi(i))
+ scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
+ fac0=1.0d0/(sint1*sint)
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ fac3=cosg*cost1/(sint1*sint1)
+ fac4=cosg*cost/(sint*sint)
! Obtaining the gamma derivatives from sine derivative
- if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
- phi(i).gt.pi34.and.phi(i).le.pi.or. &
- phi(i).ge.-pi.and.phi(i).le.-pi34) then
- call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
- dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
- -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
- dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
- dsinphi(j,2,i)= &
- -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
- -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
- dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
- dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
- +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
+ if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
+ phi(i).gt.pi34.and.phi(i).le.pi.or. &
+ phi(i).ge.-pi.and.phi(i).le.-pi34) then
+ call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
+ call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
+ do j=1,3
+ ctgt=cost/sint
+ ctgt1=cost1/sint1
+ cosg_inv=1.0d0/cosg
+ if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
+ dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
+ -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
+ dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
+ dsinphi(j,2,i)= &
+ -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
+ -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
+ dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
+ +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
- endif
+ dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
+ endif
! 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)
+ enddo
+ scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
+ fac0=1.0d0/(sint1*sint)
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ fac3=cosg*cost1/(sint1*sint1)
+ fac4=cosg*cost/(sint*sint)
! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
! Obtaining the gamma derivatives from sine derivative
- if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
- tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
- tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
- call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
- -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
- *vbld_inv(i-2+nres)
- dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
- dsintau(j,1,2,i)= &
- -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
- -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
+ 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))
+ fac0=1.0d0/(sint1*sint)
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ fac3=cosg*cost1/(sint1*sint1)
+ fac4=cosg*cost/(sint*sint)
! Obtaining the gamma derivatives from sine derivative
- if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
- tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
- tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
- call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
- +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
+ 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))
+ fac0=1.0d0/(sint1*sint)
+ fac1=cost*fac0
+ fac2=cost1*fac0
+ fac3=cosg*cost1/(sint1*sint1)
+ fac4=cosg*cost/(sint*sint)
! Obtaining the gamma derivatives from sine derivative
- if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
- tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
- tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
- call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
- -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
- *vbld_inv(i-2+nres)
- dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
- dsintau(j,3,2,i)= &
- -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
- -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
- dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
+ 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
+ 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))
+ if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
+ fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
+ fac6=fac5/vbld(i)
+ fac7=fac5*fac5
+ fac8=fac5/vbld(i+1)
+ fac9=fac5/vbld(i+nres)
+ scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
+ scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
+ cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
+ (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
+ -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
+ sina=sqrt(1-cosa*cosa)
+ sino=dsin(omeg(i))
! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
- do j=1,3
- dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
- dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
- dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
- dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
- scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
- dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
- dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
- dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
- vbld(i+nres))
- dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
- enddo
+ do j=1,3
+ dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
+ dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
+ dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
+ dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
+ scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
+ dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
+ dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
+ dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
+ vbld(i+nres))
+ dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
+ enddo
! obtaining the derivatives of omega from sines
- if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
- omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
- omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
- fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
- dsin(theta(i+1)))
- fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
- fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
- call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
- call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
- call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
- coso_inv=1.0d0/dcos(omeg(i))
- do j=1,3
- dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
- +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
- (sino*dc_norm(j,i-1))/vbld(i)
- domega(j,1,i)=coso_inv*dsinomega(j,1,i)
- dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
- +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
- -sino*dc_norm(j,i)/vbld(i+1)
- domega(j,2,i)=coso_inv*dsinomega(j,2,i)
- dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
- fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
- vbld(i+nres)
- domega(j,3,i)=coso_inv*dsinomega(j,3,i)
- enddo
- else
- ! obtaining the derivatives of omega from cosines
- fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
- fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
- fac12=fac10*sina
- fac13=fac12*fac12
- fac14=sina*sina
- do j=1,3
- dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
- dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
- (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
- fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
- domega(j,1,i)=-1/sino*dcosomega(j,1,i)
- dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
- dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
- dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
- (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
- dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
- domega(j,2,i)=-1/sino*dcosomega(j,2,i)
- dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
- scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
- (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
- domega(j,3,i)=-1/sino*dcosomega(j,3,i)
- enddo
- endif
- else
+ if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
+ omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
+ omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
+ fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
+ dsin(theta(i+1)))
+ fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
+ fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
+ call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
+ call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
+ call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
+ coso_inv=1.0d0/dcos(omeg(i))
do j=1,3
- do k=1,3
- dalpha(k,j,i)=0.0d0
- domega(k,j,i)=0.0d0
- enddo
- enddo
- endif
- enddo
+ dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
+ +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
+ (sino*dc_norm(j,i-1))/vbld(i)
+ domega(j,1,i)=coso_inv*dsinomega(j,1,i)
+ dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
+ +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
+ -sino*dc_norm(j,i)/vbld(i+1)
+ domega(j,2,i)=coso_inv*dsinomega(j,2,i)
+ dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
+ fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
+ vbld(i+nres)
+ domega(j,3,i)=coso_inv*dsinomega(j,3,i)
+ enddo
+ else
+ ! obtaining the derivatives of omega from cosines
+ fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
+ fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
+ fac12=fac10*sina
+ fac13=fac12*fac12
+ fac14=sina*sina
+ do j=1,3
+ dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
+ dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
+ (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
+ fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
+ domega(j,1,i)=-1/sino*dcosomega(j,1,i)
+ dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
+ dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
+ dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
+ (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
+ dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
+ domega(j,2,i)=-1/sino*dcosomega(j,2,i)
+ dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
+ scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
+ (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
+ domega(j,3,i)=-1/sino*dcosomega(j,3,i)
+ enddo
+ endif
+ else
+ do j=1,3
+ do k=1,3
+ dalpha(k,j,i)=0.0d0
+ domega(k,j,i)=0.0d0
+ enddo
+ enddo
+ endif
+ enddo
#endif
#if defined(MPI) && defined(PARINTDER)
- if (nfgtasks.gt.1) then
+ if (nfgtasks.gt.1) then
#ifdef DEBUG
!d write (iout,*) "Gather dtheta"
!d call flush(iout)
- write (iout,*) "dtheta before gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
- enddo
+ write (iout,*) "dtheta before gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
+ enddo
#endif
- call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
- MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
+ MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
+ king,FG_COMM,IERROR)
!#define DEBUG
#ifdef DEBUG
!d write (iout,*) "Gather dphi"
!d call flush(iout)
- write (iout,*) "dphi before gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
- enddo
+ write (iout,*) "dphi before gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
+ enddo
#endif
!#undef DEBUG
- call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
- MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
+ MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
+ king,FG_COMM,IERROR)
!d write (iout,*) "Gather dalpha"
!d call flush(iout)
#ifdef CRYST_SC
- call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
- MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
+ MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
+ king,FG_COMM,IERROR)
!d write (iout,*) "Gather domega"
!d call flush(iout)
- call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
- MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
- king,FG_COMM,IERROR)
+ call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
+ MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
+ king,FG_COMM,IERROR)
#endif
- endif
+ endif
#endif
!#define DEBUG
#ifdef DEBUG
- write (iout,*) "dtheta after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
- enddo
- write (iout,*) "dphi after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
- enddo
- write (iout,*) "dalpha after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
- enddo
- write (iout,*) "domega after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
- enddo
+ write (iout,*) "dtheta after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
+ enddo
+ write (iout,*) "dphi after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
+ enddo
+ write (iout,*) "dalpha after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
+ enddo
+ write (iout,*) "domega after gather"
+ do i=1,nres
+ write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
+ enddo
#endif
!#undef DEBUG
- return
- end subroutine intcartderiv
+ return
+ end subroutine intcartderiv
!-----------------------------------------------------------------------------
- subroutine checkintcartgrad
+ subroutine checkintcartgrad
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
- include 'mpif.h'
+ include 'mpif.h'
#endif
! include 'COMMON.CHAIN'
! include 'COMMON.VAR'
! include 'COMMON.DERIV'
! include 'COMMON.IOUNITS'
! include 'COMMON.SETUP'
- real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
- real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
- real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
- real(kind=8),dimension(3) :: dc_norm_s
- real(kind=8) :: aincr=1.0d-5
- integer :: i,j
- real(kind=8) :: dcji
- do i=1,nres
- phi_s(i)=phi(i)
- theta_s(i)=theta(i)
- alph_s(i)=alph(i)
- omeg_s(i)=omeg(i)
- enddo
+ real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
+ real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
+ real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
+ real(kind=8),dimension(3) :: dc_norm_s
+ real(kind=8) :: aincr=1.0d-5
+ integer :: i,j
+ real(kind=8) :: dcji
+ do i=1,nres
+ phi_s(i)=phi(i)
+ theta_s(i)=theta(i)
+ alph_s(i)=alph(i)
+ omeg_s(i)=omeg(i)
+ enddo
! Check theta gradient
- write (iout,*) &
- "Analytical (upper) and numerical (lower) gradient of theta"
- write (iout,*)
- do i=3,nres
- do j=1,3
- dcji=dc(j,i-2)
- dc(j,i-2)=dcji+aincr
- call chainbuild_cart
- call int_from_cart1(.false.)
- dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
- dc(j,i-2)=dcji
- dcji=dc(j,i-1)
- dc(j,i-1)=dc(j,i-1)+aincr
- call chainbuild_cart
- dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
- dc(j,i-1)=dcji
- enddo
+ write (iout,*) &
+ "Analytical (upper) and numerical (lower) gradient of theta"
+ write (iout,*)
+ do i=3,nres
+ do j=1,3
+ dcji=dc(j,i-2)
+ dc(j,i-2)=dcji+aincr
+ call chainbuild_cart
+ call int_from_cart1(.false.)
+ dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
+ dc(j,i-2)=dcji
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dc(j,i-1)+aincr
+ call chainbuild_cart
+ dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
+ dc(j,i-1)=dcji
+ enddo
!el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
!el (dtheta(j,2,i),j=1,3)
!el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
write (iout,*) &
"Analytical (upper) and numerical (lower) gradient of gamma"
do i=4,nres
- do j=1,3
- dcji=dc(j,i-3)
- dc(j,i-3)=dcji+aincr
- call chainbuild_cart
- dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-3)=dcji
- dcji=dc(j,i-2)
- dc(j,i-2)=dcji+aincr
- call chainbuild_cart
- dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-2)=dcji
- dcji=dc(j,i-1)
- dc(j,i-1)=dc(j,i-1)+aincr
- call chainbuild_cart
- dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-1)=dcji
- enddo
+ do j=1,3
+ dcji=dc(j,i-3)
+ dc(j,i-3)=dcji+aincr
+ call chainbuild_cart
+ dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-3)=dcji
+ dcji=dc(j,i-2)
+ dc(j,i-2)=dcji+aincr
+ call chainbuild_cart
+ dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-2)=dcji
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dc(j,i-1)+aincr
+ call chainbuild_cart
+ dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
+ dc(j,i-1)=dcji
+ enddo
!el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
!el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
!el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
"Analytical (upper) and numerical (lower) gradient of alpha"
do i=2,nres-1
if(itype(i,1).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
- call chainbuild_cart
- dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i-1)=dcji
- dcji=dc(j,i)
- dc(j,i)=dcji+aincr
- call chainbuild_cart
- dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i)=dcji
- dcji=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call chainbuild_cart
- dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
- /aincr
- dc(j,i+nres)=dcji
- enddo
- endif
+ do j=1,3
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dcji+aincr
+ call chainbuild_cart
+ dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i-1)=dcji
+ dcji=dc(j,i)
+ dc(j,i)=dcji+aincr
+ call chainbuild_cart
+ dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i)=dcji
+ dcji=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+aincr
+ call chainbuild_cart
+ dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
+ /aincr
+ dc(j,i+nres)=dcji
+ enddo
+ endif
!el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
!el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
!el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
"Analytical (upper) and numerical (lower) gradient of omega"
do i=2,nres-1
if(itype(i,1).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
- call chainbuild_cart
- domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i-1)=dcji
- dcji=dc(j,i)
- dc(j,i)=dcji+aincr
- call chainbuild_cart
- domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i)=dcji
- dcji=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call chainbuild_cart
- domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
- /aincr
- dc(j,i+nres)=dcji
- enddo
- endif
+ do j=1,3
+ dcji=dc(j,i-1)
+ dc(j,i-1)=dcji+aincr
+ call chainbuild_cart
+ domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i-1)=dcji
+ dcji=dc(j,i)
+ dc(j,i)=dcji+aincr
+ call chainbuild_cart
+ domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i)=dcji
+ dcji=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+aincr
+ call chainbuild_cart
+ domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
+ /aincr
+ dc(j,i+nres)=dcji
+ enddo
+ endif
!el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
!el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
!el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
qq = 0.0d0
nl=0
if(flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
+ do il=seg1+nsep,seg2
+ do jl=seg1,il-nsep
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
- endif
- qq = qq+qqij+qqijCM
- enddo
- enddo
- qq = qq/nl
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
+ endif
+ qq = qq+qqij+qqijCM
+ enddo
+ enddo
+ qq = qq/nl
else
do il=seg1,seg2
- if((seg3-il).lt.3) then
- secseg=il+3
- else
- secseg=seg3
- endif
- do jl=secseg,seg4
+ if((seg3-il).lt.3) then
+ secseg=il+3
+ else
+ secseg=seg3
+ endif
+ do jl=secseg,seg4
+ nl=nl+1
+ d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
+ (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
+ (cref(3,jl,kkk)-cref(3,il,kkk))**2)
+ dij=dist(il,jl)
+ qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
+ if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
nl=nl+1
- d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
- (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
- (cref(3,jl,kkk)-cref(3,il,kkk))**2)
- dij=dist(il,jl)
- qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
- if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt( &
- (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
- (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
- (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
- dijCM=dist(il+nres,jl+nres)
- qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
- endif
- qq = qq+qqij+qqijCM
- enddo
+ d0ijCM=dsqrt( &
+ (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
+ (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
+ (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
+ dijCM=dist(il+nres,jl+nres)
+ qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
+ endif
+ qq = qq+qqij+qqijCM
enddo
+ enddo
qq = qq/nl
endif
if (qqmax.le.qq) qqmax=qq
!el sigm(x)=0.25d0*x ! local function
do kkk=1,nperm
do i=0,nres
- do j=1,3
- dqwol(j,i)=0.0d0
- dxqwol(j,i)=0.0d0
- enddo
+ do j=1,3
+ dqwol(j,i)=0.0d0
+ dxqwol(j,i)=0.0d0
+ enddo
enddo
nl=0
if(flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
+ 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
integer :: i,j
do i=0,nres
- do j=1,3
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- cdummy(j,i)=c(j,i)
- c(j,i)=c(j,i)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolan(j,i)=(q2-q1)/delta
- c(j,i)=cdummy(j,i)
- enddo
+ do j=1,3
+ q1=qwolynes(seg1,seg2,flag,seg3,seg4)
+ cdummy(j,i)=c(j,i)
+ c(j,i)=c(j,i)+delta
+ q2=qwolynes(seg1,seg2,flag,seg3,seg4)
+ qwolan(j,i)=(q2-q1)/delta
+ c(j,i)=cdummy(j,i)
+ enddo
enddo
do i=0,nres
- do j=1,3
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- cdummy(j,i+nres)=c(j,i+nres)
- c(j,i+nres)=c(j,i+nres)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolxan(j,i)=(q2-q1)/delta
- c(j,i+nres)=cdummy(j,i+nres)
- enddo
+ do j=1,3
+ q1=qwolynes(seg1,seg2,flag,seg3,seg4)
+ cdummy(j,i+nres)=c(j,i+nres)
+ c(j,i+nres)=c(j,i+nres)+delta
+ q2=qwolynes(seg1,seg2,flag,seg3,seg4)
+ qwolxan(j,i)=(q2-q1)/delta
+ c(j,i+nres)=cdummy(j,i+nres)
+ enddo
enddo
! write(iout,*) "Numerical Q carteisan gradients backbone: "
! do i=0,nct
! include 'COMMON.TIME1'
real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
- duconst,duxconst
+ duconst,duxconst
integer :: kstart,kend,lstart,lend,idummy
real(kind=8) :: delta=1.0d-7
integer :: i,j,k,ii
do i=0,nres
- do j=1,3
- duconst(j,i)=0.0d0
- dudconst(j,i)=0.0d0
- duxconst(j,i)=0.0d0
- dudxconst(j,i)=0.0d0
- enddo
+ do j=1,3
+ duconst(j,i)=0.0d0
+ dudconst(j,i)=0.0d0
+ duxconst(j,i)=0.0d0
+ dudxconst(j,i)=0.0d0
+ enddo
enddo
Uconst=0.0d0
do i=1,nfrag
- qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
- idummy,idummy)
- Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
+ qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
+ idummy,idummy)
+ Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
! Calculating the derivatives of Constraint energy with respect to Q
- Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
- qinfrag(i,iset))
+ Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
+ qinfrag(i,iset))
! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
! hmnum=(hm2-hm1)/delta
! & qinfrag(i,iset))
! write(iout,*) "harmonicnum frag", hmnum
! Calculating the derivatives of Q with respect to cartesian coordinates
- call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
- idummy,idummy)
+ call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
+ idummy,idummy)
! write(iout,*) "dqwol "
! do ii=1,nres
! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
! & ,idummy,idummy)
! The gradients of Uconst in Cs
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
- enddo
- enddo
+ do ii=0,nres
+ do j=1,3
+ duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
+ dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
+ enddo
+ enddo
enddo
do i=1,npair
- kstart=ifrag(1,ipair(1,i,iset),iset)
- kend=ifrag(2,ipair(1,i,iset),iset)
- lstart=ifrag(1,ipair(2,i,iset),iset)
- lend=ifrag(2,ipair(2,i,iset),iset)
- qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
- Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
+ kstart=ifrag(1,ipair(1,i,iset),iset)
+ kend=ifrag(2,ipair(1,i,iset),iset)
+ lstart=ifrag(1,ipair(2,i,iset),iset)
+ lend=ifrag(2,ipair(2,i,iset),iset)
+ qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
+ Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
! Calculating dU/dQ
- Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
+ Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
! hm1=harmonic(qpair(i),qinpair(i,iset))
! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
! hmnum=(hm2-hm1)/delta
! & qinpair(i,iset))
! write(iout,*) "harmonicnum pair ", hmnum
! Calculating dQ/dXi
- call qwolynes_prim(kstart,kend,.false.,&
- lstart,lend)
+ call qwolynes_prim(kstart,kend,.false.,&
+ lstart,lend)
! write(iout,*) "dqwol "
! do ii=1,nres
! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
! call qwol_num(kstart,kend,.false.
! & ,lstart,lend)
! The gradients of Uconst in Cs
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
- enddo
- enddo
+ do ii=0,nres
+ do j=1,3
+ duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
+ dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
+ enddo
+ enddo
enddo
! write(iout,*) "Uconst inside subroutine ", Uconst
! Transforming the gradients from Cs to dCs for the backbone
do i=0,nres
- do j=i+1,nres
- do k=1,3
- dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
- enddo
+ do j=i+1,nres
+ do k=1,3
+ dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
enddo
+ enddo
enddo
! Transforming the gradients from Cs to dCs for the side chains
do i=1,nres
- do j=1,3
- dudxconst(j,i)=duxconst(j,i)
- enddo
+ do j=1,3
+ dudxconst(j,i)=duxconst(j,i)
+ enddo
enddo
! write(iout,*) "dU/ddc backbone "
! do ii=0,nres
! real(kind=8) ::
! For the backbone
do i=0,nres-1
- do j=1,3
- dUcartan(j,i)=0.0d0
- cdummy(j,i)=dc(j,i)
- dc(j,i)=dc(j,i)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- dc(j,i)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- ducartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
+ do j=1,3
+ dUcartan(j,i)=0.0d0
+ cdummy(j,i)=dc(j,i)
+ dc(j,i)=dc(j,i)+delta
+ call chainbuild_cart
+ uzap2=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ dc(j,i)=cdummy(j,i)
+ call chainbuild_cart
+ uzap1=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ ducartan(j,i)=(uzap2-uzap1)/(delta)
+ enddo
enddo
! Calculating numerical gradients for dU/ddx
do i=0,nres-1
- duxcartan(j,i)=0.0d0
- do j=1,3
- cdummy(j,i)=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
- idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- dc(j,i+nres)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
- ifrag(2,ii,iset),.true.,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
- qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
- qinpair(ii,iset))
- enddo
- duxcartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
+ duxcartan(j,i)=0.0d0
+ do j=1,3
+ cdummy(j,i)=dc(j,i+nres)
+ dc(j,i+nres)=dc(j,i+nres)+delta
+ call chainbuild_cart
+ uzap2=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
+ idummy,idummy)
+ uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ dc(j,i+nres)=cdummy(j,i)
+ call chainbuild_cart
+ uzap1=0.0d0
+ do ii=1,nfrag
+ qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
+ ifrag(2,ii,iset),.true.,idummy,idummy)
+ uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
+ qinfrag(ii,iset))
+ enddo
+ do ii=1,npair
+ kstart=ifrag(1,ipair(1,ii,iset),iset)
+ kend=ifrag(2,ipair(1,ii,iset),iset)
+ lstart=ifrag(1,ipair(2,ii,iset),iset)
+ lend=ifrag(2,ipair(2,ii,iset),iset)
+ qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
+ uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
+ qinpair(ii,iset))
+ enddo
+ duxcartan(j,i)=(uzap2-uzap1)/(delta)
+ enddo
enddo
write(iout,*) "Numerical dUconst/ddc backbone "
do ii=0,nres
- write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
+ write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
enddo
! write(iout,*) "Numerical dUconst/ddx side-chain "
! do ii=1,nres
pmax=1
do k=1,3
- c(k,i)=0.0D0
- c(k,j)=0.0D0
- c(k,nres+i)=0.0D0
- c(k,nres+j)=0.0D0
+ c(k,i)=0.0D0
+ c(k,j)=0.0D0
+ c(k,nres+i)=0.0D0
+ c(k,nres+j)=0.0D0
enddo
do l=1,lmax
! pj=ran_number(0.0D0,pi/6.0D0)
! pj=0.0D0
- do p=1,pmax
+ do p=1,pmax
!t rij=ran_number(rmin,rmax)
- c(1,j)=d*sin(pj)*cos(tj)
- c(2,j)=d*sin(pj)*sin(tj)
- c(3,j)=d*cos(pj)
+ c(1,j)=d*sin(pj)*cos(tj)
+ c(2,j)=d*sin(pj)*sin(tj)
+ c(3,j)=d*cos(pj)
- c(3,nres+i)=-rij
+ c(3,nres+i)=-rij
- c(1,i)=d*sin(wi)
- c(3,i)=-rij-d*cos(wi)
+ c(1,i)=d*sin(wi)
+ c(3,i)=-rij-d*cos(wi)
- do k=1,3
- dc(k,nres+i)=c(k,nres+i)-c(k,i)
- dc_norm(k,nres+i)=dc(k,nres+i)/d
- dc(k,nres+j)=c(k,nres+j)-c(k,j)
- dc_norm(k,nres+j)=dc(k,nres+j)/d
- enddo
+ do k=1,3
+ dc(k,nres+i)=c(k,nres+i)-c(k,i)
+ dc_norm(k,nres+i)=dc(k,nres+i)/d
+ dc(k,nres+j)=c(k,nres+j)-c(k,j)
+ dc_norm(k,nres+j)=dc(k,nres+j)/d
+ enddo
- call dyn_ssbond_ene(i,j,eij)
- enddo
+ call dyn_ssbond_ene(i,j,eij)
+ enddo
enddo
call exit(1)
return
ssA=akcm
ssB=akct*deltat12
ssC=ss_depth &
- +akth*(deltat1*deltat1+deltat2*deltat2) &
- +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
+ +akth*(deltat1*deltat1+deltat2*deltat2) &
+ +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
ssxm=ssXs-0.5D0*ssB/ssA
!-------TESTING CODE
!-------TESTING CODE
! Stop and plot energy and derivative as a function of distance
if (checkstop) then
- ssm=ssC-0.25D0*ssB*ssB/ssA
- ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
- if (ssm.lt.ljm .and. &
- dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
- nicheck=1000
- njcheck=1
- deps=0.5d-7
- else
- checkstop=.false.
- endif
+ ssm=ssC-0.25D0*ssB*ssB/ssA
+ ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
+ if (ssm.lt.ljm .and. &
+ dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
+ nicheck=1000
+ njcheck=1
+ deps=0.5d-7
+ else
+ checkstop=.false.
+ endif
endif
if (.not.checkstop) then
- nicheck=0
- njcheck=-1
+ nicheck=0
+ njcheck=-1
endif
do icheck=0,nicheck
do jcheck=-1,njcheck
if (checkstop) rij=(ssxm-1.0d0)+ &
- ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
+ ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
!-------END TESTING CODE
if (rij.gt.ljxm) then
- havebond=.false.
- ljd=rij-ljXs
- fac=(1.0D0/ljd)**expon
- e1=fac*fac*aa_aq(itypi,itypj)
- e2=fac*bb_aq(itypi,itypj)
- eij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=eij*eps3rt
- eps3der=eij*eps2rt
- eij=eij*eps2rt*eps3rt
-
- sigder=-sig/sigsq
- e1=e1*eps1*eps2rt**2*eps3rt**2
- ed=-expon*(e1+eij)/ljd
- sigder=ed*sigder
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
- -2.0D0*alf12*eps3der+sigder*sigsq_om12
+ havebond=.false.
+ ljd=rij-ljXs
+ fac=(1.0D0/ljd)**expon
+ e1=fac*fac*aa_aq(itypi,itypj)
+ e2=fac*bb_aq(itypi,itypj)
+ eij=eps1*eps2rt*eps3rt*(e1+e2)
+ eps2der=eij*eps3rt
+ eps3der=eij*eps2rt
+ eij=eij*eps2rt*eps3rt
+
+ sigder=-sig/sigsq
+ e1=e1*eps1*eps2rt**2*eps3rt**2
+ ed=-expon*(e1+eij)/ljd
+ sigder=ed*sigder
+ eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
+ eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
+ eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
+ -2.0D0*alf12*eps3der+sigder*sigsq_om12
else if (rij.lt.ssxm) then
- havebond=.true.
- ssd=rij-ssXs
- eij=ssA*ssd*ssd+ssB*ssd+ssC
-
- ed=2*akcm*ssd+akct*deltat12
- pom1=akct*ssd
- pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
- eom1=-2*akth*deltat1-pom1-om2*pom2
- eom2= 2*akth*deltat2+pom1-om1*pom2
- eom12=pom2
+ havebond=.true.
+ ssd=rij-ssXs
+ eij=ssA*ssd*ssd+ssB*ssd+ssC
+
+ ed=2*akcm*ssd+akct*deltat12
+ pom1=akct*ssd
+ pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
+ eom1=-2*akth*deltat1-pom1-om2*pom2
+ eom2= 2*akth*deltat2+pom1-om1*pom2
+ eom12=pom2
else
- omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
+ omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
- d_ssxm(1)=0.5D0*akct/ssA
- d_ssxm(2)=-d_ssxm(1)
- d_ssxm(3)=0.0D0
+ d_ssxm(1)=0.5D0*akct/ssA
+ d_ssxm(2)=-d_ssxm(1)
+ d_ssxm(3)=0.0D0
- d_ljxm(1)=sig0ij/sqrt(sigsq**3)
- d_ljxm(2)=d_ljxm(1)*sigsq_om2
- d_ljxm(3)=d_ljxm(1)*sigsq_om12
- d_ljxm(1)=d_ljxm(1)*sigsq_om1
+ d_ljxm(1)=sig0ij/sqrt(sigsq**3)
+ d_ljxm(2)=d_ljxm(1)*sigsq_om2
+ d_ljxm(3)=d_ljxm(1)*sigsq_om12
+ d_ljxm(1)=d_ljxm(1)*sigsq_om1
!-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
- xm=0.5d0*(ssxm+ljxm)
- do k=1,3
- d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
- enddo
- if (rij.lt.xm) then
- havebond=.true.
- ssm=ssC-0.25D0*ssB*ssB/ssA
- d_ssm(1)=0.5D0*akct*ssB/ssA
- d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
- d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
- d_ssm(3)=omega
- f1=(rij-xm)/(ssxm-xm)
- f2=(rij-ssxm)/(xm-ssxm)
- h1=h_base(f1,hd1)
- h2=h_base(f2,hd2)
- eij=ssm*h1+Ht*h2
- delta_inv=1.0d0/(xm-ssxm)
- deltasq_inv=delta_inv*delta_inv
- fac=ssm*hd1-Ht*hd2
- fac1=deltasq_inv*fac*(xm-rij)
- fac2=deltasq_inv*fac*(rij-ssxm)
- ed=delta_inv*(Ht*hd2-ssm*hd1)
- eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
- eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
- eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
- else
- havebond=.false.
- ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
- d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
- d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
- d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
- alf12/eps3rt)
- d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
- f1=(rij-ljxm)/(xm-ljxm)
- f2=(rij-xm)/(ljxm-xm)
- h1=h_base(f1,hd1)
- h2=h_base(f2,hd2)
- eij=Ht*h1+ljm*h2
- delta_inv=1.0d0/(ljxm-xm)
- deltasq_inv=delta_inv*delta_inv
- fac=Ht*hd1-ljm*hd2
- fac1=deltasq_inv*fac*(ljxm-rij)
- fac2=deltasq_inv*fac*(rij-xm)
- ed=delta_inv*(ljm*hd2-Ht*hd1)
- eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
- eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
- eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
- endif
+ xm=0.5d0*(ssxm+ljxm)
+ do k=1,3
+ d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
+ enddo
+ if (rij.lt.xm) then
+ havebond=.true.
+ ssm=ssC-0.25D0*ssB*ssB/ssA
+ d_ssm(1)=0.5D0*akct*ssB/ssA
+ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
+ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
+ d_ssm(3)=omega
+ f1=(rij-xm)/(ssxm-xm)
+ f2=(rij-ssxm)/(xm-ssxm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=ssm*h1+Ht*h2
+ delta_inv=1.0d0/(xm-ssxm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=ssm*hd1-Ht*hd2
+ fac1=deltasq_inv*fac*(xm-rij)
+ fac2=deltasq_inv*fac*(rij-ssxm)
+ ed=delta_inv*(Ht*hd2-ssm*hd1)
+ eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
+ eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
+ eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
+ else
+ havebond=.false.
+ ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
+ d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
+ d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
+ d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
+ alf12/eps3rt)
+ d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
+ f1=(rij-ljxm)/(xm-ljxm)
+ f2=(rij-xm)/(ljxm-xm)
+ h1=h_base(f1,hd1)
+ h2=h_base(f2,hd2)
+ eij=Ht*h1+ljm*h2
+ delta_inv=1.0d0/(ljxm-xm)
+ deltasq_inv=delta_inv*delta_inv
+ fac=Ht*hd1-ljm*hd2
+ fac1=deltasq_inv*fac*(ljxm-rij)
+ fac2=deltasq_inv*fac*(rij-xm)
+ ed=delta_inv*(ljm*hd2-Ht*hd1)
+ eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
+ eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
+ eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
+ endif
!-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
!-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
! endif
!#endif
!#endif
- dyn_ssbond_ij(i,j)=eij
+ dyn_ssbond_ij(i,j)=eij
else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
- dyn_ssbond_ij(i,j)=1.0d300
+ dyn_ssbond_ij(i,j)=1.0d300
!#ifndef CLUST
!#ifndef WHAM
! write(iout,'(a15,f12.2,f8.1,2i5)')
!-------TESTING CODE
!el if (checkstop) then
- if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
- "CHECKSTOP",rij,eij,ed
- echeck(jcheck)=eij
+ if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
+ "CHECKSTOP",rij,eij,ed
+ echeck(jcheck)=eij
!el endif
enddo
if (checkstop) then
- write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
+ write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
endif
enddo
if (checkstop) then
- transgrad=.true.
- checkstop=.false.
+ transgrad=.true.
+ checkstop=.false.
endif
!-------END TESTING CODE
do k=1,3
- dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
- dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
+ dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
+ dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
enddo
do k=1,3
- gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
+ gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
enddo
do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k) &
- +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
- +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)=gvdwx(k,j)+gg(k) &
- +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwx(k,i)=gvdwx(k,i)-gg(k) &
+ +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+ +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwx(k,j)=gvdwx(k,j)+gg(k) &
+ +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
enddo
!grad do k=i,j-1
!grad do l=1,3
!grad enddo
do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
enddo
return
end subroutine dyn_ssbond_ene
!--------------------------------------------------------------------------
- subroutine triple_ssbond_ene(resi,resj,resk,eij)
+ subroutine triple_ssbond_ene(resi,resj,resk,eij)
! implicit none
! Includes
use calc_data
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
itypj=itype(j,1)
xj=c(1,nres+j)
yj=c(2,nres+j)
zj=c(3,nres+j)
-
+ call to_box(xj,yj,zj)
dxj=dc_norm(1,nres+j)
dyj=dc_norm(2,nres+j)
dzj=dc_norm(3,nres+j)
xk=c(1,nres+k)
yk=c(2,nres+k)
zk=c(3,nres+k)
-
+ call to_box(xk,yk,zk)
dxk=dc_norm(1,nres+k)
dyk=dc_norm(2,nres+k)
dzk=dc_norm(3,nres+k)
!C derivative over rij
fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
-eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
- gg(1)=xij*fac/rij
- gg(2)=yij*fac/rij
- gg(3)=zij*fac/rij
+ gg(1)=xij*fac/rij
+ gg(2)=yij*fac/rij
+ gg(3)=zij*fac/rij
do m=1,3
- gvdwx(m,i)=gvdwx(m,i)-gg(m)
- gvdwx(m,j)=gvdwx(m,j)+gg(m)
+ gvdwx(m,i)=gvdwx(m,i)-gg(m)
+ gvdwx(m,j)=gvdwx(m,j)+gg(m)
enddo
do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,j)=gvdwc(l,j)+gg(l)
enddo
!C now derivative over rik
fac=-eij1**2/dtriss* &
(-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
-eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
- gg(1)=xik*fac/rik
- gg(2)=yik*fac/rik
- gg(3)=zik*fac/rik
+ gg(1)=xik*fac/rik
+ gg(2)=yik*fac/rik
+ gg(3)=zik*fac/rik
do m=1,3
- gvdwx(m,i)=gvdwx(m,i)-gg(m)
- gvdwx(m,k)=gvdwx(m,k)+gg(m)
+ gvdwx(m,i)=gvdwx(m,i)-gg(m)
+ gvdwx(m,k)=gvdwx(m,k)+gg(m)
enddo
do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,k)=gvdwc(l,k)+gg(l)
+ gvdwc(l,i)=gvdwc(l,i)-gg(l)
+ gvdwc(l,k)=gvdwc(l,k)+gg(l)
enddo
!C now derivative over rjk
fac=-eij2**2/dtriss* &
(-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
- gg(1)=xjk*fac/rjk
- gg(2)=yjk*fac/rjk
- gg(3)=zjk*fac/rjk
+ gg(1)=xjk*fac/rjk
+ gg(2)=yjk*fac/rjk
+ gg(3)=zjk*fac/rjk
do m=1,3
- gvdwx(m,j)=gvdwx(m,j)-gg(m)
- gvdwx(m,k)=gvdwx(m,k)+gg(m)
+ gvdwx(m,j)=gvdwx(m,j)-gg(m)
+ gvdwx(m,k)=gvdwx(m,k)+gg(m)
enddo
do l=1,3
- gvdwc(l,j)=gvdwc(l,j)-gg(l)
- gvdwc(l,k)=gvdwc(l,k)+gg(l)
+ gvdwc(l,j)=gvdwc(l,j)-gg(l)
+ gvdwc(l,k)=gvdwc(l,k)+gg(l)
enddo
return
end subroutine triple_ssbond_ene
integer :: i,j,imin,ierr
integer :: diff,allnss,newnss
integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
- newihpb,newjhpb
+ newihpb,newjhpb
logical :: found
integer,dimension(0:nfgtasks) :: i_newnss
integer,dimension(0:nfgtasks) :: displ
allnss=0
do i=1,nres-1
- do j=i+1,nres
- if (dyn_ssbond_ij(i,j).lt.1.0d300) then
- allnss=allnss+1
- allflag(allnss)=0
- allihpb(allnss)=i
- alljhpb(allnss)=j
- endif
- enddo
+ do j=i+1,nres
+ if (dyn_ssbond_ij(i,j).lt.1.0d300) then
+ allnss=allnss+1
+ allflag(allnss)=0
+ allihpb(allnss)=i
+ alljhpb(allnss)=j
+ endif
+ enddo
enddo
!mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
1 emin=1.0d300
do i=1,allnss
+ if (allflag(i).eq.0 .and. &
+ dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
+ emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
+ imin=i
+ endif
+ enddo
+ if (emin.lt.1.0d300) then
+ allflag(imin)=1
+ do i=1,allnss
if (allflag(i).eq.0 .and. &
- dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
- emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
- imin=i
+ (allihpb(i).eq.allihpb(imin) .or. &
+ alljhpb(i).eq.allihpb(imin) .or. &
+ allihpb(i).eq.alljhpb(imin) .or. &
+ alljhpb(i).eq.alljhpb(imin))) then
+ allflag(i)=-1
endif
enddo
- if (emin.lt.1.0d300) then
- allflag(imin)=1
- do i=1,allnss
- if (allflag(i).eq.0 .and. &
- (allihpb(i).eq.allihpb(imin) .or. &
- alljhpb(i).eq.allihpb(imin) .or. &
- allihpb(i).eq.alljhpb(imin) .or. &
- alljhpb(i).eq.alljhpb(imin))) then
- allflag(i)=-1
- endif
- enddo
- goto 1
+ goto 1
endif
!mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
newnss=0
do i=1,allnss
- if (allflag(i).eq.1) then
- newnss=newnss+1
- newihpb(newnss)=allihpb(i)
- newjhpb(newnss)=alljhpb(i)
- endif
+ if (allflag(i).eq.1) then
+ newnss=newnss+1
+ newihpb(newnss)=allihpb(i)
+ newjhpb(newnss)=alljhpb(i)
+ endif
enddo
#ifdef MPI
if (nfgtasks.gt.1)then
- call MPI_Reduce(newnss,g_newnss,1,&
- MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Gather(newnss,1,MPI_INTEGER,&
- i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
- displ(0)=0
- do i=1,nfgtasks-1,1
- displ(i)=i_newnss(i-1)+displ(i-1)
- enddo
- call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
- g_newihpb,i_newnss,displ,MPI_INTEGER,&
- king,FG_COMM,IERR)
- call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
- g_newjhpb,i_newnss,displ,MPI_INTEGER,&
- king,FG_COMM,IERR)
- if(fg_rank.eq.0) then
+ call MPI_Reduce(newnss,g_newnss,1,&
+ MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+ call MPI_Gather(newnss,1,MPI_INTEGER,&
+ i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_newnss(i-1)+displ(i-1)
+ enddo
+ call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
+ g_newihpb,i_newnss,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
+ g_newjhpb,i_newnss,displ,MPI_INTEGER,&
+ king,FG_COMM,IERR)
+ if(fg_rank.eq.0) then
! print *,'g_newnss',g_newnss
! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
- newnss=g_newnss
- do i=1,newnss
- newihpb(i)=g_newihpb(i)
- newjhpb(i)=g_newjhpb(i)
- enddo
- endif
+ newnss=g_newnss
+ do i=1,newnss
+ newihpb(i)=g_newihpb(i)
+ newjhpb(i)=g_newjhpb(i)
+ enddo
+ endif
endif
#endif
!mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
! print *,newnss,nss,maxdim
do i=1,nss
- found=.false.
+ found=.false.
! print *,newnss
- do j=1,newnss
+ do j=1,newnss
!! print *,j
- if (idssb(i).eq.newihpb(j) .and. &
- jdssb(i).eq.newjhpb(j)) found=.true.
- enddo
+ if (idssb(i).eq.newihpb(j) .and. &
+ jdssb(i).eq.newjhpb(j)) found=.true.
+ enddo
#ifndef CLUST
#ifndef WHAM
! write(iout,*) "found",found,i,j
- if (.not.found.and.fg_rank.eq.0) &
- write(iout,'(a15,f12.2,f8.1,2i5)') &
- "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
+ if (.not.found.and.fg_rank.eq.0) &
+ write(iout,'(a15,f12.2,f8.1,2i5)') &
+ "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
#endif
#endif
enddo
do i=1,newnss
- 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
+ if (newihpb(i).eq.idssb(j) .and. &
+ newjhpb(i).eq.jdssb(j)) found=.true.
+ enddo
#ifndef CLUST
#ifndef WHAM
! write(iout,*) "found",found,i,j
- if (.not.found.and.fg_rank.eq.0) &
- write(iout,'(a15,f12.2,f8.1,2i5)') &
- "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
+ if (.not.found.and.fg_rank.eq.0) &
+ write(iout,'(a15,f12.2,f8.1,2i5)') &
+ "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
#endif
#endif
enddo
nss=newnss
do i=1,nss
- idssb(i)=newihpb(i)
- jdssb(i)=newjhpb(i)
+ idssb(i)=newihpb(i)
+ jdssb(i)=newjhpb(i)
enddo
return
! print *, "I am in eliptran"
do i=ilip_start,ilip_end
!C do i=1,1
- if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
- cycle
+ if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
+ cycle
- positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
- if (positi.le.0.0) positi=positi+boxzsize
+ positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
+ if (positi.le.0.0) positi=positi+boxzsize
!C print *,i
!C first for peptide groups
!c for each residue check if it is in lipid or lipid water border area
if ((positi.gt.bordlipbot) &
.and.(positi.lt.bordliptop)) then
!C the energy transfer exist
- if (positi.lt.buflipbot) then
+ if (positi.lt.buflipbot) then
!C what fraction I am in
- fracinbuf=1.0d0- &
- ((positi-bordlipbot)/lipbufthick)
+ fracinbuf=1.0d0- &
+ ((positi-bordlipbot)/lipbufthick)
!C lipbufthick is thickenes of lipid buffore
- sslip=sscalelip(fracinbuf)
- ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*pepliptran
- gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
- gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*pepliptran
+ gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
+ gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
!C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
!C print *,"doing sccale for lower part"
!C print *,i,sslip,fracinbuf,ssgradlip
- elseif (positi.gt.bufliptop) then
- fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
- sslip=sscalelip(fracinbuf)
- ssgradlip=sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*pepliptran
- gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
- gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
+ elseif (positi.gt.bufliptop) then
+ fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*pepliptran
+ gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
+ gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
!C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
!C print *, "doing sscalefor top part"
!C print *,i,sslip,fracinbuf,ssgradlip
- else
- eliptran=eliptran+pepliptran
+ else
+ eliptran=eliptran+pepliptran
!C print *,"I am in true lipid"
- endif
+ endif
!C else
!C eliptran=elpitran+0.0 ! I am in water
endif
enddo
! here starts the side chain transfer
do i=ilip_start,ilip_end
- if (itype(i,1).eq.ntyp1) cycle
- positi=(mod(c(3,i+nres),boxzsize))
- if (positi.le.0) positi=positi+boxzsize
+ if (itype(i,1).eq.ntyp1) cycle
+ positi=(mod(c(3,i+nres),boxzsize))
+ if (positi.le.0) positi=positi+boxzsize
!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
!c for each residue check if it is in lipid or lipid water border area
!C respos=mod(c(3,i+nres),boxzsize)
if ((positi.gt.bordlipbot) &
.and.(positi.lt.bordliptop)) then
!C the energy transfer exist
- if (positi.lt.buflipbot) then
- fracinbuf=1.0d0- &
- ((positi-bordlipbot)/lipbufthick)
+ if (positi.lt.buflipbot) then
+ fracinbuf=1.0d0- &
+ ((positi-bordlipbot)/lipbufthick)
!C lipbufthick is thickenes of lipid buffore
- sslip=sscalelip(fracinbuf)
- ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*liptranene(itype(i,1))
- gliptranx(3,i)=gliptranx(3,i) &
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*liptranene(itype(i,1))
+ gliptranx(3,i)=gliptranx(3,i) &
+ssgradlip*liptranene(itype(i,1))
- gliptranc(3,i-1)= gliptranc(3,i-1) &
+ gliptranc(3,i-1)= gliptranc(3,i-1) &
+ssgradlip*liptranene(itype(i,1))
!C print *,"doing sccale for lower part"
- elseif (positi.gt.bufliptop) then
- fracinbuf=1.0d0- &
+ elseif (positi.gt.bufliptop) then
+ fracinbuf=1.0d0- &
((bordliptop-positi)/lipbufthick)
- sslip=sscalelip(fracinbuf)
- ssgradlip=sscagradlip(fracinbuf)/lipbufthick
- eliptran=eliptran+sslip*liptranene(itype(i,1))
- gliptranx(3,i)=gliptranx(3,i) &
+ sslip=sscalelip(fracinbuf)
+ ssgradlip=sscagradlip(fracinbuf)/lipbufthick
+ eliptran=eliptran+sslip*liptranene(itype(i,1))
+ gliptranx(3,i)=gliptranx(3,i) &
+ssgradlip*liptranene(itype(i,1))
- gliptranc(3,i-1)= gliptranc(3,i-1) &
+ gliptranc(3,i-1)= gliptranc(3,i-1) &
+ssgradlip*liptranene(itype(i,1))
!C print *, "doing sscalefor top part",sslip,fracinbuf
- else
- eliptran=eliptran+liptranene(itype(i,1))
+ else
+ eliptran=eliptran+liptranene(itype(i,1))
!C print *,"I am in true lipid"
- endif
- endif ! if in lipid or buffor
+ endif
+ endif ! if in lipid or buffor
!C else
!C eliptran=elpitran+0.0 ! I am in water
- if (energy_dec) write(iout,*) i,"eliptran=",eliptran
+ if (energy_dec) write(iout,*) i,"eliptran=",eliptran
enddo
return
end subroutine Eliptransfer
integer :: i,j,iti
Etube=0.0d0
do i=itube_start,itube_end
- enetube(i)=0.0d0
- enetube(i+nres)=0.0d0
+ enetube(i)=0.0d0
+ enetube(i+nres)=0.0d0
enddo
!C first we calculate the distance from tube center
!C for UNRES
xmin=boxxsize
ymin=boxysize
! Find minimum distance in periodic box
- do j=-1,1
- vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
- vectube(2)=vectube(2)+boxysize*j
- xminact=abs(vectube(1)-tubecenter(1))
- yminact=abs(vectube(2)-tubecenter(2))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- enddo
+ do j=-1,1
+ vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+ xminact=abs(vectube(1)-tubecenter(1))
+ yminact=abs(vectube(2)-tubecenter(2))
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
vectube(1)=vectube(1)-tubecenter(1)
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*pep_aa_tube/rdiff6- &
- 6.0d0*pep_bb_tube)/rdiff6/rdiff
+ 6.0d0*pep_bb_tube)/rdiff6/rdiff
!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
!C &rdiff,fac
!C now direction of gg_tube vector
- do j=1,3
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
- gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
- enddo
- enddo
+ do j=1,3
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+ gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+ enddo
+ enddo
!C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
!C print *,gg_tube(1,0),"TU"
do i=itube_start,itube_end
!C Lets not jump over memory as we use many times iti
- iti=itype(i,1)
+ iti=itype(i,1)
!C lets ommit dummy atoms for now
- if ((iti.eq.ntyp1) &
+ if ((iti.eq.ntyp1) &
!C in UNRES uncomment the line below as GLY has no side-chain...
!C .or.(iti.eq.10)
- ) cycle
+ ) cycle
xmin=boxxsize
ymin=boxysize
- do j=-1,1
- vectube(1)=mod((c(1,i+nres)),boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=mod((c(2,i+nres)),boxysize)
- vectube(2)=vectube(2)+boxysize*j
-
- xminact=abs(vectube(1)-tubecenter(1))
- yminact=abs(vectube(2)-tubecenter(2))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- enddo
+ do j=-1,1
+ vectube(1)=mod((c(1,i+nres)),boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=mod((c(2,i+nres)),boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+
+ xminact=abs(vectube(1)-tubecenter(1))
+ yminact=abs(vectube(2)-tubecenter(2))
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
!C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
sc_bb_tube=sc_bb_tube_par(iti)
enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
- 6.0d0*sc_bb_tube/rdiff6/rdiff
+ 6.0d0*sc_bb_tube/rdiff6/rdiff
!C now direction of gg_tube vector
- do j=1,3
- gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
- enddo
- enddo
- do i=itube_start,itube_end
- Etube=Etube+enetube(i)+enetube(i+nres)
- enddo
+ do j=1,3
+ gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+ enddo
+ enddo
+ do i=itube_start,itube_end
+ Etube=Etube+enetube(i)+enetube(i+nres)
+ enddo
!C print *,"ETUBE", etube
- return
- end subroutine calctube
+ return
+ end subroutine calctube
!C TO DO 1) add to total energy
!C 2) add to gradient summation
!C 3) add reading parameters (AND of course oppening of PARAM file)
!C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
!C simple Kihara potential
subroutine calctube2(Etube)
- real(kind=8),dimension(3) :: vectube
+ real(kind=8),dimension(3) :: vectube
real(kind=8) :: Etube,xtemp,xminact,yminact,&
ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
sstube,ssgradtube,sc_aa_tube,sc_bb_tube
integer:: i,j,iti
Etube=0.0d0
do i=itube_start,itube_end
- enetube(i)=0.0d0
- enetube(i+nres)=0.0d0
+ enetube(i)=0.0d0
+ enetube(i+nres)=0.0d0
enddo
!C first we calculate the distance from tube center
!C first sugare-phosphate group for NARES this would be peptide group
!C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
xmin=boxxsize
ymin=boxysize
- do j=-1,1
- vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
- vectube(2)=vectube(2)+boxysize*j
-
- xminact=abs(vectube(1)-tubecenter(1))
- yminact=abs(vectube(2)-tubecenter(2))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- enddo
+ do j=-1,1
+ vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+
+ xminact=abs(vectube(1)-tubecenter(1))
+ yminact=abs(vectube(2)-tubecenter(2))
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
vectube(1)=vectube(1)-tubecenter(1)
!C and its 6 power
rdiff6=rdiff**6.0d0
!C THIS FRAGMENT MAKES TUBE FINITE
- positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
- if (positi.le.0) positi=positi+boxzsize
+ positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
+ if (positi.le.0) positi=positi+boxzsize
!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
!c for each residue check if it is in lipid or lipid water border area
!C respos=mod(c(3,i+nres),boxzsize)
!C print *,positi,bordtubebot,buftubebot,bordtubetop
if ((positi.gt.bordtubebot) &
- .and.(positi.lt.bordtubetop)) then
+ .and.(positi.lt.bordtubetop)) then
!C the energy transfer exist
- if (positi.lt.buftubebot) then
- fracinbuf=1.0d0- &
- ((positi-bordtubebot)/tubebufthick)
+ if (positi.lt.buftubebot) then
+ fracinbuf=1.0d0- &
+ ((positi-bordtubebot)/tubebufthick)
!C lipbufthick is thickenes of lipid buffore
- sstube=sscalelip(fracinbuf)
- ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
!C print *,ssgradtube, sstube,tubetranene(itype(i,1))
- enetube(i)=enetube(i)+sstube*tubetranenepep
+ enetube(i)=enetube(i)+sstube*tubetranenepep
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *,"doing sccale for lower part"
- elseif (positi.gt.buftubetop) then
- fracinbuf=1.0d0- &
- ((bordtubetop-positi)/tubebufthick)
- sstube=sscalelip(fracinbuf)
- ssgradtube=sscagradlip(fracinbuf)/tubebufthick
- enetube(i)=enetube(i)+sstube*tubetranenepep
+ elseif (positi.gt.buftubetop) then
+ fracinbuf=1.0d0- &
+ ((bordtubetop-positi)/tubebufthick)
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=sscagradlip(fracinbuf)/tubebufthick
+ enetube(i)=enetube(i)+sstube*tubetranenepep
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *, "doing sscalefor top part",sslip,fracinbuf
- else
- sstube=1.0d0
- ssgradtube=0.0d0
- enetube(i)=enetube(i)+sstube*tubetranenepep
+ else
+ sstube=1.0d0
+ ssgradtube=0.0d0
+ enetube(i)=enetube(i)+sstube*tubetranenepep
!C print *,"I am in true lipid"
- endif
- else
+ endif
+ else
!C sstube=0.0d0
!C ssgradtube=0.0d0
- cycle
- endif ! if in lipid or buffor
+ cycle
+ endif ! if in lipid or buffor
!C for vectorization reasons we will sumup at the end to avoid depenence of previous
enetube(i)=enetube(i)+sstube* &
- (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
+ (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
!C write(iout,*) "TU13",i,rdiff6,enetube(i)
!C print *,rdiff,rdiff6,pep_aa_tube
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*pep_aa_tube/rdiff6- &
- 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
+ 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
!C &rdiff,fac
!C now direction of gg_tube vector
do j=1,3
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
- gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
- enddo
- gg_tube(3,i)=gg_tube(3,i) &
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+ gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+ enddo
+ gg_tube(3,i)=gg_tube(3,i) &
+ssgradtube*enetube(i)/sstube/2.0d0
- gg_tube(3,i-1)= gg_tube(3,i-1) &
+ gg_tube(3,i-1)= gg_tube(3,i-1) &
+ssgradtube*enetube(i)/sstube/2.0d0
- enddo
+ enddo
!C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
!C print *,gg_tube(1,0),"TU"
- do i=itube_start,itube_end
+ do i=itube_start,itube_end
!C Lets not jump over memory as we use many times iti
- iti=itype(i,1)
+ iti=itype(i,1)
!C lets ommit dummy atoms for now
- if ((iti.eq.ntyp1) &
+ if ((iti.eq.ntyp1) &
!!C in UNRES uncomment the line below as GLY has no side-chain...
- .or.(iti.eq.10) &
- ) cycle
- vectube(1)=c(1,i+nres)
- vectube(1)=mod(vectube(1),boxxsize)
- if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
- vectube(2)=c(2,i+nres)
- vectube(2)=mod(vectube(2),boxysize)
- if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
+ .or.(iti.eq.10) &
+ ) cycle
+ vectube(1)=c(1,i+nres)
+ vectube(1)=mod(vectube(1),boxxsize)
+ if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
+ vectube(2)=c(2,i+nres)
+ vectube(2)=mod(vectube(2),boxysize)
+ if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
vectube(1)=vectube(1)-tubecenter(1)
vectube(2)=vectube(2)-tubecenter(2)
!C THIS FRAGMENT MAKES TUBE FINITE
- positi=(mod(c(3,i+nres),boxzsize))
- if (positi.le.0) positi=positi+boxzsize
+ positi=(mod(c(3,i+nres),boxzsize))
+ if (positi.le.0) positi=positi+boxzsize
!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
!c for each residue check if it is in lipid or lipid water border area
!C respos=mod(c(3,i+nres),boxzsize)
!C print *,positi,bordtubebot,buftubebot,bordtubetop
if ((positi.gt.bordtubebot) &
- .and.(positi.lt.bordtubetop)) then
+ .and.(positi.lt.bordtubetop)) then
!C the energy transfer exist
- if (positi.lt.buftubebot) then
- fracinbuf=1.0d0- &
- ((positi-bordtubebot)/tubebufthick)
+ if (positi.lt.buftubebot) then
+ fracinbuf=1.0d0- &
+ ((positi-bordtubebot)/tubebufthick)
!C lipbufthick is thickenes of lipid buffore
- sstube=sscalelip(fracinbuf)
- ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
!C print *,ssgradtube, sstube,tubetranene(itype(i,1))
- enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
+ enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *,"doing sccale for lower part"
- elseif (positi.gt.buftubetop) then
- fracinbuf=1.0d0- &
- ((bordtubetop-positi)/tubebufthick)
+ elseif (positi.gt.buftubetop) then
+ fracinbuf=1.0d0- &
+ ((bordtubetop-positi)/tubebufthick)
- sstube=sscalelip(fracinbuf)
- ssgradtube=sscagradlip(fracinbuf)/tubebufthick
- enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
+ sstube=sscalelip(fracinbuf)
+ ssgradtube=sscagradlip(fracinbuf)/tubebufthick
+ enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
!C gg_tube_SC(3,i)=gg_tube_SC(3,i)
!C &+ssgradtube*tubetranene(itype(i,1))
!C gg_tube(3,i-1)= gg_tube(3,i-1)
!C &+ssgradtube*tubetranene(itype(i,1))
!C print *, "doing sscalefor top part",sslip,fracinbuf
- else
- sstube=1.0d0
- ssgradtube=0.0d0
- enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
+ else
+ sstube=1.0d0
+ ssgradtube=0.0d0
+ enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
!C print *,"I am in true lipid"
- endif
- else
+ endif
+ else
!C sstube=0.0d0
!C ssgradtube=0.0d0
- cycle
- endif ! if in lipid or buffor
+ cycle
+ endif ! if in lipid or buffor
!CEND OF FINITE FRAGMENT
!C as the tube is infinity we do not calculate the Z-vector use of Z
!C as chosen axis
sc_aa_tube=sc_aa_tube_par(iti)
sc_bb_tube=sc_bb_tube_par(iti)
enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
- *sstube+enetube(i+nres)
+ *sstube+enetube(i+nres)
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
- 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
+ 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
!C now direction of gg_tube vector
- do j=1,3
- gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
- enddo
- gg_tube_SC(3,i)=gg_tube_SC(3,i) &
+ do j=1,3
+ gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+ enddo
+ gg_tube_SC(3,i)=gg_tube_SC(3,i) &
+ssgradtube*enetube(i+nres)/sstube
- gg_tube(3,i-1)= gg_tube(3,i-1) &
+ gg_tube(3,i-1)= gg_tube(3,i-1) &
+ssgradtube*enetube(i+nres)/sstube
- enddo
- do i=itube_start,itube_end
- Etube=Etube+enetube(i)+enetube(i+nres)
- enddo
+ enddo
+ do i=itube_start,itube_end
+ Etube=Etube+enetube(i)+enetube(i+nres)
+ enddo
!C print *,"ETUBE", etube
- return
- end subroutine calctube2
+ return
+ end subroutine calctube2
!=====================================================================================================================================
subroutine calcnano(Etube)
real(kind=8),dimension(3) :: vectube
Etube=0.0d0
! print *,itube_start,itube_end,"poczatek"
do i=itube_start,itube_end
- enetube(i)=0.0d0
- enetube(i+nres)=0.0d0
+ enetube(i)=0.0d0
+ enetube(i+nres)=0.0d0
enddo
!C first we calculate the distance from tube center
!C first sugare-phosphate group for NARES this would be peptide group
ymin=boxysize
zmin=boxzsize
- do j=-1,1
- vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
- vectube(2)=vectube(2)+boxysize*j
- vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
- vectube(3)=vectube(3)+boxzsize*j
+ do j=-1,1
+ vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+ vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
+ vectube(3)=vectube(3)+boxzsize*j
- xminact=dabs(vectube(1)-tubecenter(1))
- yminact=dabs(vectube(2)-tubecenter(2))
- zminact=dabs(vectube(3)-tubecenter(3))
+ xminact=dabs(vectube(1)-tubecenter(1))
+ yminact=dabs(vectube(2)-tubecenter(2))
+ zminact=dabs(vectube(3)-tubecenter(3))
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- if (zmin.gt.zminact) then
- zmin=zminact
- ztemp=vectube(3)
- endif
- enddo
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ if (zmin.gt.zminact) then
+ zmin=zminact
+ ztemp=vectube(3)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
vectube(3)=ztemp
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=(-12.0d0*pep_aa_tube/rdiff6- &
- 6.0d0*pep_bb_tube)/rdiff6/rdiff
+ 6.0d0*pep_bb_tube)/rdiff6/rdiff
!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
!C &rdiff,fac
- if (acavtubpep.eq.0.0d0) then
+ if (acavtubpep.eq.0.0d0) then
!C go to 667
- enecavtube(i)=0.0
- faccav=0.0
- else
- denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
- enecavtube(i)= &
- (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
- /denominator
- enecavtube(i)=0.0
- faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
- *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
- +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
- /denominator**2.0d0
+ enecavtube(i)=0.0
+ faccav=0.0
+ else
+ denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
+ enecavtube(i)= &
+ (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
+ /denominator
+ enecavtube(i)=0.0
+ faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
+ *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
+ +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
+ /denominator**2.0d0
!C faccav=0.0
!C fac=fac+faccav
!C 667 continue
- endif
- if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
- do j=1,3
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
- gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
- enddo
- enddo
+ endif
+ if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
+ do j=1,3
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+ gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+ enddo
+ enddo
do i=itube_start,itube_end
- enecavtube(i)=0.0d0
+ enecavtube(i)=0.0d0
!C Lets not jump over memory as we use many times iti
- iti=itype(i,1)
+ iti=itype(i,1)
!C lets ommit dummy atoms for now
- if ((iti.eq.ntyp1) &
+ if ((iti.eq.ntyp1) &
!C in UNRES uncomment the line below as GLY has no side-chain...
!C .or.(iti.eq.10)
- ) cycle
+ ) cycle
xmin=boxxsize
ymin=boxysize
zmin=boxzsize
- do j=-1,1
- vectube(1)=dmod((c(1,i+nres)),boxxsize)
- vectube(1)=vectube(1)+boxxsize*j
- vectube(2)=dmod((c(2,i+nres)),boxysize)
- vectube(2)=vectube(2)+boxysize*j
- vectube(3)=dmod((c(3,i+nres)),boxzsize)
- vectube(3)=vectube(3)+boxzsize*j
-
-
- xminact=dabs(vectube(1)-tubecenter(1))
- yminact=dabs(vectube(2)-tubecenter(2))
- zminact=dabs(vectube(3)-tubecenter(3))
-
- if (xmin.gt.xminact) then
- xmin=xminact
- xtemp=vectube(1)
- endif
- if (ymin.gt.yminact) then
- ymin=yminact
- ytemp=vectube(2)
- endif
- if (zmin.gt.zminact) then
- zmin=zminact
- ztemp=vectube(3)
- endif
- enddo
+ do j=-1,1
+ vectube(1)=dmod((c(1,i+nres)),boxxsize)
+ vectube(1)=vectube(1)+boxxsize*j
+ vectube(2)=dmod((c(2,i+nres)),boxysize)
+ vectube(2)=vectube(2)+boxysize*j
+ vectube(3)=dmod((c(3,i+nres)),boxzsize)
+ vectube(3)=vectube(3)+boxzsize*j
+
+
+ xminact=dabs(vectube(1)-tubecenter(1))
+ yminact=dabs(vectube(2)-tubecenter(2))
+ zminact=dabs(vectube(3)-tubecenter(3))
+
+ if (xmin.gt.xminact) then
+ xmin=xminact
+ xtemp=vectube(1)
+ endif
+ if (ymin.gt.yminact) then
+ ymin=yminact
+ ytemp=vectube(2)
+ endif
+ if (zmin.gt.zminact) then
+ zmin=zminact
+ ztemp=vectube(3)
+ endif
+ enddo
vectube(1)=xtemp
vectube(2)=ytemp
vectube(3)=ztemp
!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
!C now we calculate gradient
fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
- 6.0d0*sc_bb_tube/rdiff6/rdiff
+ 6.0d0*sc_bb_tube/rdiff6/rdiff
!C fac=0.0
!C now direction of gg_tube vector
!C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
- if (acavtub(iti).eq.0.0d0) then
+ if (acavtub(iti).eq.0.0d0) then
!C go to 667
- enecavtube(i+nres)=0.0d0
- faccav=0.0d0
- else
- denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
- enecavtube(i+nres)= &
- (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
- /denominator
+ enecavtube(i+nres)=0.0d0
+ faccav=0.0d0
+ else
+ denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
+ enecavtube(i+nres)= &
+ (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
+ /denominator
!C enecavtube(i)=0.0
- faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
- *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
- +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
- /denominator**2.0d0
+ faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
+ *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
+ +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
+ /denominator**2.0d0
!C faccav=0.0
- fac=fac+faccav
+ fac=fac+faccav
!C 667 continue
- endif
+ endif
!C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
!C & enecavtube(i),faccav
!C print *,"licz=",
!C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
!C print *,"finene=",enetube(i+nres)+enecavtube(i)
- do j=1,3
- gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
- gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
- enddo
- if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
- enddo
+ do j=1,3
+ gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+ gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+ enddo
+ if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
+ enddo
- do i=itube_start,itube_end
- Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
- +enecavtube(i+nres)
- enddo
+ do i=itube_start,itube_end
+ Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
+ +enecavtube(i+nres)
+ enddo
! do i=1,20
! print *,"begin", i,"a"
! do r=1,10000
! print *,"end",i,"a"
! enddo
!C print *,"ETUBE", etube
- return
- end subroutine calcnano
+ return
+ end subroutine calcnano
!===============================================
!--------------------------------------------------------------------------------
subroutine set_shield_fac2
real(kind=8) :: div77_81=0.974996043d0, &
- div4_81=0.2222222222d0
+ div4_81=0.2222222222d0
real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
- scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
- short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
- sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
+ scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
+ short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
+ sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
!C the vector between center of side_chain and peptide group
real(kind=8),dimension(3) :: pep_side_long,side_calf, &
- pept_group,costhet_grad,cosphi_grad_long, &
- cosphi_grad_loc,pep_side_norm,side_calf_norm, &
- sh_frac_dist_grad,pep_side
- integer i,j,k
+ pept_group,costhet_grad,cosphi_grad_long, &
+ cosphi_grad_loc,pep_side_norm,side_calf_norm, &
+ sh_frac_dist_grad,pep_side
+ integer i,j,k
!C write(2,*) "ivec",ivec_start,ivec_end
do i=1,nres
- fac_shield(i)=0.0d0
- ishield_list(i)=0
- do j=1,3
- grad_shield(j,i)=0.0d0
- enddo
+ fac_shield(i)=0.0d0
+ ishield_list(i)=0
+ do j=1,3
+ grad_shield(j,i)=0.0d0
+ enddo
enddo
do i=ivec_start,ivec_end
!C do i=1,nres-1
dist_pept_group=sqrt(dist_pept_group)
dist_side_calf=sqrt(dist_side_calf)
do j=1,3
- pep_side_norm(j)=pep_side(j)/dist_pep_side
- side_calf_norm(j)=dist_side_calf
+ pep_side_norm(j)=pep_side(j)/dist_pep_side
+ side_calf_norm(j)=dist_side_calf
enddo
!C now sscale fraction
sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
! print *,buff_shield,"buff",sh_frac_dist
!C now sscale
- if (sh_frac_dist.le.0.0) cycle
+ if (sh_frac_dist.le.0.0) cycle
!C print *,ishield_list(i),i
!C If we reach here it means that this side chain reaches the shielding sphere
!C Lets add him to the list for gradient
- ishield_list(i)=ishield_list(i)+1
+ ishield_list(i)=ishield_list(i)+1
!C ishield_list is a list of non 0 side-chain that contribute to factor gradient
!C this list is essential otherwise problem would be O3
- shield_list(ishield_list(i),i)=k
+ shield_list(ishield_list(i),i)=k
!C Lets have the sscale value
- if (sh_frac_dist.gt.1.0) then
- scale_fac_dist=1.0d0
- do j=1,3
- sh_frac_dist_grad(j)=0.0d0
- enddo
- else
- scale_fac_dist=-sh_frac_dist*sh_frac_dist &
- *(2.0d0*sh_frac_dist-3.0d0)
- fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
- /dist_pep_side/buff_shield*0.5d0
- do j=1,3
- sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
+ if (sh_frac_dist.gt.1.0) then
+ scale_fac_dist=1.0d0
+ do j=1,3
+ sh_frac_dist_grad(j)=0.0d0
+ enddo
+ else
+ scale_fac_dist=-sh_frac_dist*sh_frac_dist &
+ *(2.0d0*sh_frac_dist-3.0d0)
+ fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
+ /dist_pep_side/buff_shield*0.5d0
+ do j=1,3
+ sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
!C sh_frac_dist_grad(j)=0.0d0
!C scale_fac_dist=1.0d0
!C print *,"jestem",scale_fac_dist,fac_help_scale,
!C & sh_frac_dist_grad(j)
- enddo
- endif
+ enddo
+ endif
!C this is what is now we have the distance scaling now volume...
short=short_r_sidechain(itype(k,1))
long=long_r_sidechain(itype(k,1))
!C & -short/dist_pep_side**2/costhet)
!C costhet_fac=0.0d0
do j=1,3
- costhet_grad(j)=costhet_fac*pep_side(j)
+ costhet_grad(j)=costhet_fac*pep_side(j)
enddo
!C remember for the final gradient multiply costhet_grad(j)
!C for side_chain by factor -2 !
!C cosphi=0.6
cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
- dist_pep_side**2)
+ dist_pep_side**2)
!C sinphi=0.8
do j=1,3
- cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
+ cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
*(long-short)/fac_alfa_sin*cosalfa/ &
((dist_pep_side*dist_side_calf))* &
((side_calf(j))-cosalfa* &
((pep_side(j)/dist_pep_side)*dist_side_calf))
!C cosphi_grad_long(j)=0.0d0
- cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
+ cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
*(long-short)/fac_alfa_sin*cosalfa &
/((dist_pep_side*dist_side_calf))* &
(pep_side(j)- &
enddo
!C print *,sinphi,sinthet
VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
- /VSolvSphere_div
+ /VSolvSphere_div
!C & *wshield
!C now the gradient...
do j=1,3
grad_shield(j,i)=grad_shield(j,i) &
!C gradient po skalowaniu
- +(sh_frac_dist_grad(j)*VofOverlap &
+ +(sh_frac_dist_grad(j)*VofOverlap &
!C gradient po costhet
- +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
- (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
- sinphi/sinthet*costhet*costhet_grad(j) &
- +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
- )*wshield
+ +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
+ (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
+ sinphi/sinthet*costhet*costhet_grad(j) &
+ +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
+ )*wshield
!C grad_shield_side is Cbeta sidechain gradient
grad_shield_side(j,ishield_list(i),i)=&
- (sh_frac_dist_grad(j)*-2.0d0&
- *VofOverlap&
- -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
+ (sh_frac_dist_grad(j)*-2.0d0&
+ *VofOverlap&
+ -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
- sinphi/sinthet*costhet*costhet_grad(j)&
- +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
- )*wshield
+ sinphi/sinthet*costhet*costhet_grad(j)&
+ +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
+ )*wshield
! print *, 1.0d0/(-dsqrt(1.0d0-sinphi*sinthet)),&
! sinphi/sinthet,&
! +sinthet/sinphi,"HERE"
grad_shield_loc(j,ishield_list(i),i)= &
- scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
+ scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
- sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
- ))&
- *wshield
+ sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
+ ))&
+ *wshield
! print *,grad_shield_loc(j,ishield_list(i),i)
enddo
VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
character(len=80) :: controlcard
do i=1,dyn_nssHist
- call card_concat(controlcard,.true.)
- read(controlcard,*) &
- dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
+ call card_concat(controlcard,.true.)
+ read(controlcard,*) &
+ dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
enddo
return
!el
! get the position of the jth ijth fragment of the chain coordinate system
! in the fromto array.
- integer :: i,j
+ integer :: i,j
- indmat=((2*(nres-2)-i)*(i-1))/2+j-1
+ indmat=((2*(nres-2)-i)*(i-1))/2+j-1
return
end function indmat
!-----------------------------------------------------------------------------
real(kind=8) function sigm(x)
!el
real(kind=8) :: x
- sigm=0.25d0*x
+ sigm=0.25d0*x
return
end function sigm
!-----------------------------------------------------------------------------
integer :: i,j
if(nres.lt.100) then
- maxconts=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
maxvar=6*nres ! Max. number of variables
! enddo
! if (nss.gt.0) then
- allocate(idssb(maxdim),jdssb(maxdim))
+ allocate(idssb(maxdim),jdssb(maxdim))
! allocate(newihpb(nss),newjhpb(nss))
!(maxdim)
! endif
allocate(uzgrad(3,3,2,nres))
!(3,3,2,maxres)
! allocateion of lists JPRDLA
- allocate(newcontlistppi(200*nres))
- allocate(newcontlistscpi(200*nres))
- allocate(newcontlisti(200*nres))
- allocate(newcontlistppj(200*nres))
- allocate(newcontlistscpj(200*nres))
- allocate(newcontlistj(200*nres))
+ allocate(newcontlistppi(300*nres))
+ allocate(newcontlistscpi(300*nres))
+ allocate(newcontlisti(300*nres))
+ allocate(newcontlistppj(300*nres))
+ allocate(newcontlistscpj(300*nres))
+ allocate(newcontlistj(300*nres))
return
end subroutine alloc_ener_arrays
write (iout,*) "ibondp_start,ibondp_end",&
ibondp_nucl_start,ibondp_nucl_end
do i=ibondp_nucl_start,ibondp_nucl_end
- if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
- itype(i,2).eq.ntyp1_molec(2)) cycle
+ if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
+ itype(i,2).eq.ntyp1_molec(2)) cycle
! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
! do j=1,3
! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
! & "estr1",i,vbld(i),distchainmax,
! & gnmr1(vbld(i),-1.0d0,distchainmax)
- diff = vbld(i)-vbldp0_nucl
- if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
- vbldp0_nucl,diff,AKP_nucl*diff*diff
- estr_nucl=estr_nucl+diff*diff
+ diff = vbld(i)-vbldp0_nucl
+ if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
+ vbldp0_nucl,diff,AKP_nucl*diff*diff
+ estr_nucl=estr_nucl+diff*diff
! print *,estr_nucl
- do j=1,3
- gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
- enddo
+ do j=1,3
+ gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
+ enddo
!c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
enddo
estr_nucl=0.5d0*AKP_nucl*estr_nucl
do i=ibond_nucl_start,ibond_nucl_end
!C print *, "I am stuck",i
- iti=itype(i,2)
- if (iti.eq.ntyp1_molec(2)) cycle
- nbi=nbondterm_nucl(iti)
+ iti=itype(i,2)
+ if (iti.eq.ntyp1_molec(2)) cycle
+ nbi=nbondterm_nucl(iti)
!C print *,iti,nbi
- if (nbi.eq.1) then
- diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
+ if (nbi.eq.1) then
+ diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
- if (energy_dec) &
- write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
- AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
- estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
+ if (energy_dec) &
+ write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
+ AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
+ estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
! print *,estr_nucl
- do j=1,3
- gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
- enddo
- else
- do j=1,nbi
- diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
- ud(j)=aksc_nucl(j,iti)*diff
- u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
- enddo
- uprod=u(1)
- do j=2,nbi
- uprod=uprod*u(j)
- enddo
- usum=0.0d0
- usumsqder=0.0d0
- do j=1,nbi
- uprod1=1.0d0
- uprod2=1.0d0
- do k=1,nbi
- if (k.ne.j) then
- uprod1=uprod1*u(k)
- uprod2=uprod2*u(k)*u(k)
- endif
- enddo
- usum=usum+uprod1
- usumsqder=usumsqder+ud(j)*uprod2
- enddo
- estr_nucl=estr_nucl+uprod/usum
- do j=1,3
- gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
+ do j=1,3
+ gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
+ enddo
+ else
+ do j=1,nbi
+ diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
+ ud(j)=aksc_nucl(j,iti)*diff
+ u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
+ enddo
+ uprod=u(1)
+ do j=2,nbi
+ uprod=uprod*u(j)
+ enddo
+ usum=0.0d0
+ usumsqder=0.0d0
+ do j=1,nbi
+ uprod1=1.0d0
+ uprod2=1.0d0
+ do k=1,nbi
+ if (k.ne.j) then
+ uprod1=uprod1*u(k)
+ uprod2=uprod2*u(k)*u(k)
+ endif
enddo
- endif
+ usum=usum+uprod1
+ usumsqder=usumsqder+ud(j)*uprod2
+ enddo
+ estr_nucl=estr_nucl+uprod/usum
+ do j=1,3
+ gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
+ enddo
+ endif
enddo
!C print *,"I am about to leave ebond"
return
etheta_nucl=0.0D0
! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
do i=ithet_nucl_start,ithet_nucl_end
- if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
- (itype(i-2,2).eq.ntyp1_molec(2)).or. &
- (itype(i,2).eq.ntyp1_molec(2))) cycle
- dethetai=0.0d0
- dephii=0.0d0
- dephii1=0.0d0
- theti2=0.5d0*theta(i)
- ityp2=ithetyp_nucl(itype(i-1,2))
- do k=1,nntheterm_nucl
- coskt(k)=dcos(k*theti2)
- sinkt(k)=dsin(k*theti2)
- enddo
- if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
+ if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
+ (itype(i-2,2).eq.ntyp1_molec(2)).or. &
+ (itype(i,2).eq.ntyp1_molec(2))) cycle
+ dethetai=0.0d0
+ dephii=0.0d0
+ dephii1=0.0d0
+ theti2=0.5d0*theta(i)
+ ityp2=ithetyp_nucl(itype(i-1,2))
+ do k=1,nntheterm_nucl
+ coskt(k)=dcos(k*theti2)
+ sinkt(k)=dsin(k*theti2)
+ enddo
+ if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
#ifdef OSF
- phii=phi(i)
- if (phii.ne.phii) phii=150.0
+ phii=phi(i)
+ if (phii.ne.phii) phii=150.0
#else
- phii=phi(i)
+ phii=phi(i)
#endif
- ityp1=ithetyp_nucl(itype(i-2,2))
- do k=1,nsingle_nucl
- cosph1(k)=dcos(k*phii)
- sinph1(k)=dsin(k*phii)
- enddo
- else
- phii=0.0d0
- ityp1=nthetyp_nucl+1
- do k=1,nsingle_nucl
- cosph1(k)=0.0d0
- sinph1(k)=0.0d0
- enddo
- endif
+ ityp1=ithetyp_nucl(itype(i-2,2))
+ do k=1,nsingle_nucl
+ cosph1(k)=dcos(k*phii)
+ sinph1(k)=dsin(k*phii)
+ enddo
+ else
+ phii=0.0d0
+ ityp1=nthetyp_nucl+1
+ do k=1,nsingle_nucl
+ cosph1(k)=0.0d0
+ sinph1(k)=0.0d0
+ enddo
+ endif
- if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
+ if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
#ifdef OSF
- phii1=phi(i+1)
- if (phii1.ne.phii1) phii1=150.0
- phii1=pinorm(phii1)
+ phii1=phi(i+1)
+ if (phii1.ne.phii1) phii1=150.0
+ phii1=pinorm(phii1)
#else
- phii1=phi(i+1)
+ phii1=phi(i+1)
#endif
- ityp3=ithetyp_nucl(itype(i,2))
- do k=1,nsingle_nucl
- cosph2(k)=dcos(k*phii1)
- sinph2(k)=dsin(k*phii1)
- enddo
- else
- phii1=0.0d0
- ityp3=nthetyp_nucl+1
- do k=1,nsingle_nucl
- cosph2(k)=0.0d0
- sinph2(k)=0.0d0
- enddo
- endif
- ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
- do k=1,ndouble_nucl
- do l=1,k-1
- ccl=cosph1(l)*cosph2(k-l)
- ssl=sinph1(l)*sinph2(k-l)
- scl=sinph1(l)*cosph2(k-l)
- csl=cosph1(l)*sinph2(k-l)
- cosph1ph2(l,k)=ccl-ssl
- cosph1ph2(k,l)=ccl+ssl
- sinph1ph2(l,k)=scl+csl
- sinph1ph2(k,l)=scl-csl
- enddo
+ ityp3=ithetyp_nucl(itype(i,2))
+ do k=1,nsingle_nucl
+ cosph2(k)=dcos(k*phii1)
+ sinph2(k)=dsin(k*phii1)
enddo
- if (lprn) then
- write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
- " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
- write (iout,*) "coskt and sinkt",nntheterm_nucl
- do k=1,nntheterm_nucl
- write (iout,*) k,coskt(k),sinkt(k)
+ else
+ phii1=0.0d0
+ ityp3=nthetyp_nucl+1
+ do k=1,nsingle_nucl
+ cosph2(k)=0.0d0
+ sinph2(k)=0.0d0
enddo
- endif
- do k=1,ntheterm_nucl
- ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
- dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
- *coskt(k)
- if (lprn)&
- write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
- " ethetai",ethetai
+ endif
+ ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
+ do k=1,ndouble_nucl
+ do l=1,k-1
+ ccl=cosph1(l)*cosph2(k-l)
+ ssl=sinph1(l)*sinph2(k-l)
+ scl=sinph1(l)*cosph2(k-l)
+ csl=cosph1(l)*sinph2(k-l)
+ cosph1ph2(l,k)=ccl-ssl
+ cosph1ph2(k,l)=ccl+ssl
+ sinph1ph2(l,k)=scl+csl
+ sinph1ph2(k,l)=scl-csl
enddo
- if (lprn) then
- write (iout,*) "cosph and sinph"
+ enddo
+ if (lprn) then
+ write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
+ " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
+ write (iout,*) "coskt and sinkt",nntheterm_nucl
+ do k=1,nntheterm_nucl
+ write (iout,*) k,coskt(k),sinkt(k)
+ enddo
+ endif
+ do k=1,ntheterm_nucl
+ ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
+ dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
+ *coskt(k)
+ if (lprn)&
+ write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
+ " ethetai",ethetai
+ enddo
+ if (lprn) then
+ write (iout,*) "cosph and sinph"
+ do k=1,nsingle_nucl
+ write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
+ enddo
+ write (iout,*) "cosph1ph2 and sinph2ph2"
+ do k=2,ndouble_nucl
+ do l=1,k-1
+ write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
+ sinph1ph2(l,k),sinph1ph2(k,l)
+ enddo
+ enddo
+ write(iout,*) "ethetai",ethetai
+ endif
+ do m=1,ntheterm2_nucl
do k=1,nsingle_nucl
- write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
+ aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
+ +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
+ +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
+ +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
+ ethetai=ethetai+sinkt(m)*aux
+ dethetai=dethetai+0.5d0*m*aux*coskt(m)
+ dephii=dephii+k*sinkt(m)*(&
+ ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
+ bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
+ dephii1=dephii1+k*sinkt(m)*(&
+ eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
+ ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
+ if (lprn) &
+ write (iout,*) "m",m," k",k," bbthet",&
+ bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
+ ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
+ ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
+ eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
enddo
- write (iout,*) "cosph1ph2 and sinph2ph2"
+ enddo
+ if (lprn) &
+ write(iout,*) "ethetai",ethetai
+ do m=1,ntheterm3_nucl
do k=2,ndouble_nucl
do l=1,k-1
- write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
- sinph1ph2(l,k),sinph1ph2(k,l)
- enddo
- enddo
- write(iout,*) "ethetai",ethetai
- endif
- do m=1,ntheterm2_nucl
- do k=1,nsingle_nucl
- aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
- +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
- +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
- +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
+ aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*aux*coskt(m)
- dephii=dephii+k*sinkt(m)*(&
- ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
- bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
- dephii1=dephii1+k*sinkt(m)*(&
- eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
- ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
- if (lprn) &
- write (iout,*) "m",m," k",k," bbthet",&
- bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
- ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
- ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
- eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
- enddo
- enddo
- if (lprn) &
- write(iout,*) "ethetai",ethetai
- do m=1,ntheterm3_nucl
- do k=2,ndouble_nucl
- do l=1,k-1
- aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
- ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*coskt(m)*aux
- dephii=dephii+l*sinkt(m)*(&
- -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
- dephii1=dephii1+(k-l)*sinkt(m)*( &
- -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
- if (lprn) then
- write (iout,*) "m",m," k",k," l",l," ffthet", &
- ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
- ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
- ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
- ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
- write (iout,*) cosph1ph2(l,k)*sinkt(m), &
- cosph1ph2(k,l)*sinkt(m),&
- sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
- endif
- enddo
+ dethetai=dethetai+0.5d0*m*coskt(m)*aux
+ dephii=dephii+l*sinkt(m)*(&
+ -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
+ dephii1=dephii1+(k-l)*sinkt(m)*( &
+ -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
+ if (lprn) then
+ write (iout,*) "m",m," k",k," l",l," ffthet", &
+ ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
+ ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
+ ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
+ ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
+ write (iout,*) cosph1ph2(l,k)*sinkt(m), &
+ cosph1ph2(k,l)*sinkt(m),&
+ sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
+ endif
enddo
enddo
+ enddo
10 continue
- if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
- i,theta(i)*rad2deg,phii*rad2deg, &
- phii1*rad2deg,ethetai
- etheta_nucl=etheta_nucl+ethetai
+ if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
+ i,theta(i)*rad2deg,phii*rad2deg, &
+ phii1*rad2deg,ethetai
+ etheta_nucl=etheta_nucl+ethetai
! print *,i,"partial sum",etheta_nucl
- if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
- if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
- gloc(nphi+i-2,icg)=wang_nucl*dethetai
+ if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
+ if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
+ gloc(nphi+i-2,icg)=wang_nucl*dethetai
enddo
return
end subroutine ebend_nucl
!el local variables
integer :: i,j,iblock,itori,itori1
real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
- vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
+ vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
! Set lprn=.true. for debugging
lprn=.false.
! lprn=.true.
etors_nucl=0.0D0
! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
do i=iphi_nucl_start,iphi_nucl_end
- if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
- .or. itype(i-3,2).eq.ntyp1_molec(2) &
- .or. itype(i,2).eq.ntyp1_molec(2)) cycle
- etors_ii=0.0D0
- itori=itortyp_nucl(itype(i-2,2))
- itori1=itortyp_nucl(itype(i-1,2))
- phii=phi(i)
+ if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
+ .or. itype(i-3,2).eq.ntyp1_molec(2) &
+ .or. itype(i,2).eq.ntyp1_molec(2)) cycle
+ etors_ii=0.0D0
+ itori=itortyp_nucl(itype(i-2,2))
+ itori1=itortyp_nucl(itype(i-1,2))
+ phii=phi(i)
! print *,i,itori,itori1
- gloci=0.0D0
+ gloci=0.0D0
!C Regular cosine and sine terms
- do j=1,nterm_nucl(itori,itori1)
- v1ij=v1_nucl(j,itori,itori1)
- v2ij=v2_nucl(j,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
- if (energy_dec) etors_ii=etors_ii+&
- v1ij*cosphi+v2ij*sinphi
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
+ do j=1,nterm_nucl(itori,itori1)
+ v1ij=v1_nucl(j,itori,itori1)
+ v2ij=v2_nucl(j,itori,itori1)
+ cosphi=dcos(j*phii)
+ sinphi=dsin(j*phii)
+ etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
+ if (energy_dec) etors_ii=etors_ii+&
+ v1ij*cosphi+v2ij*sinphi
+ gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
+ enddo
!C Lorentz terms
!C v1
!C E = SUM ----------------------------------- - v1
!C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
!C
- cosphi=dcos(0.5d0*phii)
- sinphi=dsin(0.5d0*phii)
- do j=1,nlor_nucl(itori,itori1)
- vl1ij=vlor1_nucl(j,itori,itori1)
- vl2ij=vlor2_nucl(j,itori,itori1)
- vl3ij=vlor3_nucl(j,itori,itori1)
- pom=vl2ij*cosphi+vl3ij*sinphi
- pom1=1.0d0/(pom*pom+1.0d0)
- etors_nucl=etors_nucl+vl1ij*pom1
- if (energy_dec) etors_ii=etors_ii+ &
- vl1ij*pom1
- pom=-pom*pom1*pom1
- gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
- enddo
+ cosphi=dcos(0.5d0*phii)
+ sinphi=dsin(0.5d0*phii)
+ do j=1,nlor_nucl(itori,itori1)
+ vl1ij=vlor1_nucl(j,itori,itori1)
+ vl2ij=vlor2_nucl(j,itori,itori1)
+ vl3ij=vlor3_nucl(j,itori,itori1)
+ pom=vl2ij*cosphi+vl3ij*sinphi
+ pom1=1.0d0/(pom*pom+1.0d0)
+ etors_nucl=etors_nucl+vl1ij*pom1
+ if (energy_dec) etors_ii=etors_ii+ &
+ vl1ij*pom1
+ pom=-pom*pom1*pom1
+ gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
+ enddo
!C Subtract the constant term
- etors_nucl=etors_nucl-v0_nucl(itori,itori1)
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
- 'etor',i,etors_ii-v0_nucl(itori,itori1)
- if (lprn) &
+ etors_nucl=etors_nucl-v0_nucl(itori,itori1)
+ if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
+ 'etor',i,etors_ii-v0_nucl(itori,itori1)
+ if (lprn) &
write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
(v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
- gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
+ gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
!c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
enddo
return
!C the orientation of the CA-CA virtual bonds.
!C
integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
- real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
+ real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbbi,sslipi,ssgradlipi, &
+ sslipj,ssgradlipj,faclipij2
real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
- dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
- dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
+ dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
+ dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,sss_grad,fac,evdw1ij
+ dist_temp, dist_init,sss_grad,fac,evdw1ij
integer xshift,yshift,zshift
real(kind=8),dimension(3):: ggg,gggp,gggm,erij
real(kind=8) :: ees,eesij
!c
! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
do i=iatel_s_nucl,iatel_e_nucl
- if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- xmedi=dmod(xmedi,boxxsize)
- if (xmedi.lt.0) xmedi=xmedi+boxxsize
- ymedi=dmod(ymedi,boxysize)
- if (ymedi.lt.0) ymedi=ymedi+boxysize
- zmedi=dmod(zmedi,boxzsize)
- if (zmedi.lt.0) zmedi=zmedi+boxzsize
-
- do j=ielstart_nucl(i),ielend_nucl(i)
- if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
- ind=ind+1
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
+ if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
+ dxi=dc(1,i)
+ dyi=dc(2,i)
+ dzi=dc(3,i)
+ dx_normi=dc_norm(1,i)
+ dy_normi=dc_norm(2,i)
+ dz_normi=dc_norm(3,i)
+ xmedi=c(1,i)+0.5d0*dxi
+ ymedi=c(2,i)+0.5d0*dyi
+ zmedi=c(3,i)+0.5d0*dzi
+ call to_box(xmedi,ymedi,zmedi)
+ call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
+
+ do j=ielstart_nucl(i),ielend_nucl(i)
+ if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
+ ind=ind+1
+ dxj=dc(1,j)
+ dyj=dc(2,j)
+ dzj=dc(3,j)
! xj=c(1,j)+0.5D0*dxj-xmedi
! yj=c(2,j)+0.5D0*dyj-ymedi
! zj=c(3,j)+0.5D0*dzj-zmedi
- xj=c(1,j)+0.5D0*dxj
- yj=c(2,j)+0.5D0*dyj
- zj=c(3,j)+0.5D0*dzj
- xj=mod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=mod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=mod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- isubchap=0
- dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- isubchap=1
- endif
- enddo
- enddo
- enddo
- if (isubchap.eq.1) then
-!C print *,i,j
- xj=xj_temp-xmedi
- yj=yj_temp-ymedi
- zj=zj_temp-zmedi
- else
- xj=xj_safe-xmedi
- yj=yj_safe-ymedi
- zj=zj_safe-zmedi
- endif
-
- rij=xj*xj+yj*yj+zj*zj
+ xj=c(1,j)+0.5D0*dxj
+ yj=c(2,j)+0.5D0*dyj
+ zj=c(3,j)+0.5D0*dzj
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+ xj=boxshift(xj-xmedi,boxxsize)
+ yj=boxshift(yj-ymedi,boxysize)
+ zj=boxshift(zj-zmedi,boxzsize)
+ rij=xj*xj+yj*yj+zj*zj
!c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
- fac=(r0pp**2/rij)**3
- ev1=epspp*fac*fac
- ev2=epspp*fac
- evdw1ij=ev1-2*ev2
- fac=(-ev1-evdw1ij)/rij
+ fac=(r0pp**2/rij)**3
+ ev1=epspp*fac*fac
+ ev2=epspp*fac
+ evdw1ij=ev1-2*ev2
+ fac=(-ev1-evdw1ij)/rij
! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
- if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
- evdw1=evdw1+evdw1ij
+ if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
+ evdw1=evdw1+evdw1ij
!C
!C Calculate contributions to the Cartesian gradient.
!C
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
- do k=1,3
- gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
- gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
- enddo
+ ggg(1)=fac*xj
+ ggg(2)=fac*yj
+ ggg(3)=fac*zj
+ do k=1,3
+ gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
+ gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
+ enddo
!c phoshate-phosphate electrostatic interactions
- rij=dsqrt(rij)
- fac=1.0d0/rij
- eesij=dexp(-BEES*rij)*fac
+ rij=dsqrt(rij)
+ fac=1.0d0/rij
+ eesij=dexp(-BEES*rij)*fac
! write (2,*)"fac",fac," eesijpp",eesij
- if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
- ees=ees+eesij
+ if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
+ ees=ees+eesij
!c fac=-eesij*fac
- fac=-(fac+BEES)*eesij*fac
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
+ fac=-(fac+BEES)*eesij*fac
+ ggg(1)=fac*xj
+ ggg(2)=fac*yj
+ ggg(3)=fac*zj
!c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
!c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
!c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
- do k=1,3
- gelpp(k,i)=gelpp(k,i)-ggg(k)
- gelpp(k,j)=gelpp(k,j)+ggg(k)
- enddo
- enddo ! j
+ do k=1,3
+ gelpp(k,i)=gelpp(k,i)-ggg(k)
+ gelpp(k,j)=gelpp(k,j)+ggg(k)
+ enddo
+ enddo ! j
enddo ! i
!c ees=332.0d0*ees
ees=AEES*ees
do i=nnt,nct
!c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
- do k=1,3
- gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
+ do k=1,3
+ gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
!c gelpp(k,i)=332.0d0*gelpp(k,i)
- gelpp(k,i)=AEES*gelpp(k,i)
- enddo
+ gelpp(k,i)=AEES*gelpp(k,i)
+ enddo
!c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
enddo
!c write (2,*) "total EES",ees
real(kind=8),dimension(3):: ggg
integer :: i,iint,j,k,iteli,itypj,subchap
real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
- e1,e2,evdwij,rij,evdwpsb,eelpsb
+ e1,e2,evdwij,rij,evdwpsb,eelpsb
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init
+ dist_temp, dist_init
integer xshift,yshift,zshift
!cd print '(a)','Enter ESCP'
evdwpsb=0.0d0
! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
do i=iatscp_s_nucl,iatscp_e_nucl
- if (itype(i,2).eq.ntyp1_molec(2) &
- .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
- xi=0.5D0*(c(1,i)+c(1,i+1))
- yi=0.5D0*(c(2,i)+c(2,i+1))
- zi=0.5D0*(c(3,i)+c(3,i+1))
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
+ 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 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
+ 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
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- 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"
+ 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,*) "x",(x(k),k=1,9)
#ifdef DEBUG
- write (2,*) "x",(x(k),k=1,9)
+ write (2,*) "x",(x(k),k=1,9)
!C
!C This section to check the numerical derivatives of the energy of ith side
!C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
!C #define DEBUG in the code to turn it on.
!C
- write (2,*) "sumene =",sumene
- aincr=1.0d-7
- xxsave=xx
- xx=xx+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dxx_num=(sumenep-sumene)/aincr
- xx=xxsave
- write (2,*) "xx+ sumene from enesc=",sumenep,sumene
- yysave=yy
- yy=yy+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dyy_num=(sumenep-sumene)/aincr
- yy=yysave
- write (2,*) "yy+ sumene from enesc=",sumenep,sumene
- zzsave=zz
- zz=zz+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dzz_num=(sumenep-sumene)/aincr
- zz=zzsave
- write (2,*) "zz+ sumene from enesc=",sumenep,sumene
- costsave=cost2tab(i+1)
- sintsave=sint2tab(i+1)
- cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
- sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dt_num=(sumenep-sumene)/aincr
- write (2,*) " t+ sumene from enesc=",sumenep,sumene
- cost2tab(i+1)=costsave
- sint2tab(i+1)=sintsave
+ write (2,*) "sumene =",sumene
+ aincr=1.0d-7
+ xxsave=xx
+ xx=xx+aincr
+ write (2,*) xx,yy,zz
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dxx_num=(sumenep-sumene)/aincr
+ xx=xxsave
+ write (2,*) "xx+ sumene from enesc=",sumenep,sumene
+ yysave=yy
+ yy=yy+aincr
+ write (2,*) xx,yy,zz
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dyy_num=(sumenep-sumene)/aincr
+ yy=yysave
+ write (2,*) "yy+ sumene from enesc=",sumenep,sumene
+ zzsave=zz
+ zz=zz+aincr
+ write (2,*) xx,yy,zz
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dzz_num=(sumenep-sumene)/aincr
+ zz=zzsave
+ write (2,*) "zz+ sumene from enesc=",sumenep,sumene
+ costsave=cost2tab(i+1)
+ sintsave=sint2tab(i+1)
+ cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
+ sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
+ sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+ de_dt_num=(sumenep-sumene)/aincr
+ write (2,*) " t+ sumene from enesc=",sumenep,sumene
+ cost2tab(i+1)=costsave
+ sint2tab(i+1)=sintsave
!C End of diagnostics section.
#endif
!C
!C Compute the gradient of esc
!C
- de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
- de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
- de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
- de_dtt=0.0d0
+ de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
+ de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
+ de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
+ de_dtt=0.0d0
#ifdef DEBUG
- write (2,*) "x",(x(k),k=1,9)
- write (2,*) "xx",xx," yy",yy," zz",zz
- write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
- " de_zz ",de_zz," de_tt ",de_tt
- write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
- " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
+ write (2,*) "x",(x(k),k=1,9)
+ write (2,*) "xx",xx," yy",yy," zz",zz
+ write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
+ " de_zz ",de_zz," de_tt ",de_tt
+ write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
+ " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
#endif
!C
cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
cosfac2xx=cosfac2*xx
sinfac2yy=sinfac2*yy
do k = 1,3
- dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
- vbld_inv(i+1)
- dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
- vbld_inv(i)
- pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
- pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
+ dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
+ vbld_inv(i+1)
+ dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
+ vbld_inv(i)
+ pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
+ pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
!c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
!c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
!c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
!c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
- dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
- dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
- dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
- dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
- dZZ_Ci1(k)=0.0d0
- dZZ_Ci(k)=0.0d0
- do j=1,3
- dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
- dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
- enddo
+ dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
+ dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
+ dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
+ dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
+ dZZ_Ci1(k)=0.0d0
+ dZZ_Ci(k)=0.0d0
+ do j=1,3
+ dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
+ dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
+ enddo
- dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
- dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
- dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
+ dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
+ dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
+ dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
!c
- dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
- dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
+ dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
+ dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
enddo
do k=1,3
- dXX_Ctab(k,i)=dXX_Ci(k)
- dXX_C1tab(k,i)=dXX_Ci1(k)
- dYY_Ctab(k,i)=dYY_Ci(k)
- dYY_C1tab(k,i)=dYY_Ci1(k)
- dZZ_Ctab(k,i)=dZZ_Ci(k)
- dZZ_C1tab(k,i)=dZZ_Ci1(k)
- dXX_XYZtab(k,i)=dXX_XYZ(k)
- dYY_XYZtab(k,i)=dYY_XYZ(k)
- dZZ_XYZtab(k,i)=dZZ_XYZ(k)
+ dXX_Ctab(k,i)=dXX_Ci(k)
+ dXX_C1tab(k,i)=dXX_Ci1(k)
+ dYY_Ctab(k,i)=dYY_Ci(k)
+ dYY_C1tab(k,i)=dYY_Ci1(k)
+ dZZ_Ctab(k,i)=dZZ_Ci(k)
+ dZZ_C1tab(k,i)=dZZ_Ci1(k)
+ dXX_XYZtab(k,i)=dXX_XYZ(k)
+ dYY_XYZtab(k,i)=dYY_XYZ(k)
+ dZZ_XYZtab(k,i)=dZZ_XYZ(k)
enddo
do k = 1,3
!c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
!c & dt_dci(k)
!c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
!c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
- gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
- +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
- gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
- +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
- gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
- +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
+ gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
+ +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
+ gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
+ +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
+ gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
+ +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
enddo
!c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
!c write (2,*) "x",(x(i),i=1,9)
!c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
- + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
- + x(9)*yy*zz
+ + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
+ + x(9)*yy*zz
enesc_nucl=sumene
return
end function enesc_nucl
if (nfgtasks.le.1) goto 30
if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-1
- write (iout,'(2i3,50(1x,i2,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
- j=1,num_cont_hb(i))
- enddo
+ write (iout,'(a)') 'Contact function values:'
+ do i=nnt,nct-1
+ write (iout,'(2i3,50(1x,i2,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
+ j=1,num_cont_hb(i))
+ enddo
endif
!C Caution! Following code assumes that electrostatic interactions concerning
!C a given atom are split among at most two processors!
CorrelID=fg_rank+1
ldone=.false.
do i=1,max_cont
- do j=1,max_dim
- buffer(i,j)=0.0D0
- enddo
+ do j=1,max_dim
+ buffer(i,j)=0.0D0
+ enddo
enddo
mm=mod(fg_rank,2)
!c write (*,*) 'MyRank',MyRank,' mm',mm
!c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
if (fg_rank.gt.0) then
!C Send correlation contributions to the preceding processor
- msglen=msglen1
- nn=num_cont_hb(iatel_s_nucl)
- call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
+ msglen=msglen1
+ nn=num_cont_hb(iatel_s_nucl)
+ call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
!c write (*,*) 'The BUFFER array:'
!c do i=1,nn
!c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
!c enddo
- if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
- msglen=msglen2
- call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
+ if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
+ msglen=msglen2
+ call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
!C Clear the contacts of the atom passed to the neighboring processor
- nn=num_cont_hb(iatel_s_nucl+1)
+ nn=num_cont_hb(iatel_s_nucl+1)
!c do i=1,nn
!c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
!c enddo
- num_cont_hb(iatel_s_nucl)=0
- endif
+ num_cont_hb(iatel_s_nucl)=0
+ endif
!cd write (iout,*) 'Processor ',fg_rank,MyRank,
!cd & ' is sending correlation contribution to processor',fg_rank-1,
!cd & ' msglen=',msglen
!c write (*,*) 'Processor ',fg_rank,MyRank,
!c & ' is sending correlation contribution to processor',fg_rank-1,
!c & ' msglen=',msglen,' CorrelType=',CorrelType
- time00=MPI_Wtime()
- call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
- CorrelType,FG_COMM,IERROR)
- time_sendrecv=time_sendrecv+MPI_Wtime()-time00
+ time00=MPI_Wtime()
+ call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
+ CorrelType,FG_COMM,IERROR)
+ time_sendrecv=time_sendrecv+MPI_Wtime()-time00
!cd write (iout,*) 'Processor ',fg_rank,
!cd & ' has sent correlation contribution to processor',fg_rank-1,
!cd & ' msglen=',msglen,' CorrelID=',CorrelID
!c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
if (fg_rank.lt.nfgtasks-1) then
!C Receive correlation contributions from the next processor
- msglen=msglen1
- if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
+ msglen=msglen1
+ if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
!cd write (iout,*) 'Processor',fg_rank,
!cd & ' is receiving correlation contribution from processor',fg_rank+1,
!cd & ' msglen=',msglen,' CorrelType=',CorrelType
!c write (*,*) 'Processor',fg_rank,
!c &' is receiving correlation contribution from processor',fg_rank+1,
!c & ' msglen=',msglen,' CorrelType=',CorrelType
- time00=MPI_Wtime()
- nbytes=-1
- do while (nbytes.le.0)
- call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
- call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
- enddo
+ time00=MPI_Wtime()
+ nbytes=-1
+ do while (nbytes.le.0)
+ call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
+ call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
+ enddo
!c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
- call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
- fg_rank+1,CorrelType,FG_COMM,status,IERROR)
- time_sendrecv=time_sendrecv+MPI_Wtime()-time00
+ call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
+ fg_rank+1,CorrelType,FG_COMM,status,IERROR)
+ time_sendrecv=time_sendrecv+MPI_Wtime()-time00
!c write (*,*) 'Processor',fg_rank,
!c &' has received correlation contribution from processor',fg_rank+1,
!c & ' msglen=',msglen,' nbytes=',nbytes
!c do i=1,max_cont
!c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
!c enddo
- if (msglen.eq.msglen1) then
- call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
- else if (msglen.eq.msglen2) then
- call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
- call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
- else
- write (iout,*) &
+ if (msglen.eq.msglen1) then
+ call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
+ else if (msglen.eq.msglen2) then
+ call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
+ call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
+ else
+ write (iout,*) &
'ERROR!!!! message length changed while processing correlations.'
- write (*,*) &
+ write (*,*) &
'ERROR!!!! message length changed while processing correlations.'
- call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
- endif ! msglen.eq.msglen1
+ call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
+ endif ! msglen.eq.msglen1
endif ! fg_rank.lt.nfgtasks-1
if (ldone) goto 30
ldone=.true.
30 continue
#endif
if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt_molec(2),nct_molec(2)-1
- write (iout,'(2i3,50(1x,i2,f5.2))') &
- i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
- j=1,num_cont_hb(i))
- enddo
+ write (iout,'(a)') 'Contact function values:'
+ do i=nnt_molec(2),nct_molec(2)-1
+ write (iout,'(2i3,50(1x,i2,f5.2))') &
+ i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
+ j=1,num_cont_hb(i))
+ enddo
endif
ecorr=0.0D0
ecorr3=0.0d0
! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
!C Calculate the local-electrostatic correlation terms
do i=iatsc_s_nucl,iatsc_e_nucl
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
+ i1=i+1
+ num_conti=num_cont_hb(i)
+ num_conti1=num_cont_hb(i+1)
! print *,i,num_conti,num_conti1
- do jj=1,num_conti
- j=jcont_hb(jj,i)
- do kk=1,num_conti1
- j1=jcont_hb(kk,i1)
+ do jj=1,num_conti
+ j=jcont_hb(jj,i)
+ do kk=1,num_conti1
+ j1=jcont_hb(kk,i1)
!c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
!c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1 .or. j1.eq.j-1) then
+ if (j1.eq.j+1 .or. j1.eq.j-1) then
!C
!C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
!C The system gains extra energy.
!C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
!C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
!C
- ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
- 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
- n_corr=n_corr+1
- else if (j1.eq.j) then
+ ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
+ 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
+ n_corr=n_corr+1
+ else if (j1.eq.j) then
!C
!C Contacts I-J and I-(J+1) occur simultaneously.
!C The system loses extra energy.
!C
!c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
!c & ' jj=',jj,' kk=',kk
- ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
- endif
- enddo ! kk
- do kk=1,num_conti
- j1=jcont_hb(kk,i)
+ ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
+ endif
+ enddo ! kk
+ do kk=1,num_conti
+ j1=jcont_hb(kk,i)
!c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
!c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1) then
+ if (j1.eq.j+1) then
!C Contacts I-J and (I+1)-J occur simultaneously.
!C The system loses extra energy.
- ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
- endif ! j1==j+1
- enddo ! kk
- enddo ! jj
+ ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
+ endif ! j1==j+1
+ enddo ! kk
+ enddo ! jj
enddo ! i
return
end subroutine multibody_hb_nucl
!el local variables
integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
- ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
- coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
- rlocshield
+ ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
+ coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
+ rlocshield
lprn=.false.
eij=facont_hb(jj,i)
coeffpees0pkl=coeffp*ees0pkl
coeffmees0mkl=coeffm*ees0mkl
do ll=1,3
- gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
+ gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
-ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
coeffmees0mkl*gacontm_hb1(ll,jj,i))
- gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
- -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
- coeffmees0mkl*gacontm_hb2(ll,jj,i))
- gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
- -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
- coeffmees0mij*gacontm_hb1(ll,kk,k))
- gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
- -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb2(ll,kk,k))
- gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
- ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb3(ll,jj,i))
- gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
- gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
- gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
- ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb3(ll,kk,k))
- gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
- gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
- gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
- gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
- gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
- gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
+ gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
+ -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
+ coeffmees0mkl*gacontm_hb2(ll,jj,i))
+ gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
+ -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
+ coeffmees0mij*gacontm_hb1(ll,kk,k))
+ gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
+ -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb2(ll,kk,k))
+ gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
+ ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb3(ll,jj,i))
+ gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
+ gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
+ gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
+ ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb3(ll,kk,k))
+ gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
+ gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
+ gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
+ gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
+ gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
+ gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
enddo
ehbcorr_nucl=ekont*ees
return
!el local variables
integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
- ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
- coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
- rlocshield
+ ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
+ coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
+ rlocshield
lprn=.false.
eij=facont_hb(jj,i)
coeffpees0pkl=coeffp*ees0pkl
coeffmees0mkl=coeffm*ees0mkl
do ll=1,3
- gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
+ gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
-ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
coeffmees0mkl*gacontm_hb1(ll,jj,i))
- gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
- -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb2(ll,jj,i))
- gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
- -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb1(ll,kk,k))
- gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
- -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb2(ll,kk,k))
- gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
- ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
- coeffmees0mkl*gacontm_hb3(ll,jj,i))
- gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
- gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
- gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
- ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
- coeffmees0mij*gacontm_hb3(ll,kk,k))
- gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
- gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
- gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
- gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
- gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
- gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
+ gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
+ -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb2(ll,jj,i))
+ gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
+ -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb1(ll,kk,k))
+ gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
+ -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb2(ll,kk,k))
+ gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
+ ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
+ coeffmees0mkl*gacontm_hb3(ll,jj,i))
+ gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
+ gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
+ gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
+ ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
+ coeffmees0mij*gacontm_hb3(ll,kk,k))
+ gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
+ gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
+ gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
+ gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
+ gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
+ gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
enddo
ehbcorr3_nucl=ekont*ees
return
real(kind=8):: buffer(dimen1,dimen2)
num_kont=num_cont_hb(atom)
do i=1,num_kont
- do k=1,8
- do j=1,3
- buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
- enddo ! j
- enddo ! k
- buffer(i,indx+25)=facont_hb(i,atom)
- buffer(i,indx+26)=ees0p(i,atom)
- buffer(i,indx+27)=ees0m(i,atom)
- buffer(i,indx+28)=d_cont(i,atom)
- buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
+ do k=1,8
+ do j=1,3
+ buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
+ enddo ! j
+ enddo ! k
+ buffer(i,indx+25)=facont_hb(i,atom)
+ buffer(i,indx+26)=ees0p(i,atom)
+ buffer(i,indx+27)=ees0m(i,atom)
+ buffer(i,indx+28)=d_cont(i,atom)
+ buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
enddo ! i
buffer(1,indx+30)=dfloat(num_kont)
return
num_kont_old=num_cont_hb(atom)
num_cont_hb(atom)=num_kont+num_kont_old
do i=1,num_kont
- ii=i+num_kont_old
- do k=1,8
- do j=1,3
- zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
- enddo ! j
- enddo ! k
- facont_hb(ii,atom)=buffer(i,indx+25)
- ees0p(ii,atom)=buffer(i,indx+26)
- ees0m(ii,atom)=buffer(i,indx+27)
- d_cont(i,atom)=buffer(i,indx+28)
- jcont_hb(ii,atom)=buffer(i,indx+29)
+ ii=i+num_kont_old
+ do k=1,8
+ do j=1,3
+ zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
+ enddo ! j
+ enddo ! k
+ facont_hb(ii,atom)=buffer(i,indx+25)
+ ees0p(ii,atom)=buffer(i,indx+26)
+ ees0m(ii,atom)=buffer(i,indx+27)
+ d_cont(i,atom)=buffer(i,indx+28)
+ jcont_hb(ii,atom)=buffer(i,indx+29)
enddo ! i
return
end subroutine unpack_buffer
!c------------------------------------------------------------------------------
#endif
subroutine ecatcat(ecationcation)
- integer :: i,j,itmp,xshift,yshift,zshift,subchap,k,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
+ integer :: i,j,itmp,xshift,yshift,zshift,subchap,k,itypi,itypj
+ real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
+ r7,r4,ecationcation,k0,rcal,aa,bb,sslipi,ssgradlipi,sslipj,ssgradlipj
+ real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
+ dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
+ real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
+ gg,r
+
+ ecationcation=0.0d0
+ if (nres_molec(5).eq.0) return
+ rcat0=3.472
+ epscalc=0.05
+ r06 = rcat0**6
+ r012 = r06**2
! k0 = 332.0*(2.0*2.0)/80.0
- itmp=0
-
- do i=1,4
- itmp=itmp+nres_molec(i)
- enddo
+ itmp=0
+
+ do i=1,4
+ itmp=itmp+nres_molec(i)
+ enddo
! write(iout,*) "itmp",itmp
- do i=itmp+1,itmp+nres_molec(5)-1
+ do i=itmp+1,itmp+nres_molec(5)-1
- xi=c(1,i)
- yi=c(2,i)
- zi=c(3,i)
+ xi=c(1,i)
+ yi=c(2,i)
+ zi=c(3,i)
! write (iout,*) i,"TUTUT",c(1,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)
+ 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
+ k0 = 332.0*(ichargecat(itypi)*ichargecat(itypj))/80.0
! print *,i,j,'catcat'
- xj=c(1,j)
- yj=c(2,j)
- zj=c(3,j)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
-! write(iout,*) c(1,i),xi,xj,"xy",boxxsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+ xj=c(1,j)
+ yj=c(2,j)
+ zj=c(3,j)
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
rcal =xj**2+yj**2+zj**2
- ract=sqrt(rcal)
+ ract=sqrt(rcal)
! rcat0=3.472
! epscalc=0.05
! r06 = rcat0**6
! r012 = r06**2
! k0 = 332*(2*2)/80
- Evan1cat=epscalc*(r012/(rcal**6))
- Evan2cat=epscalc*2*(r06/(rcal**3))
- Eeleccat=k0/ract
- r7 = rcal**7
- r4 = rcal**4
- r(1)=xj
- r(2)=yj
- r(3)=zj
- do k=1,3
- dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
- dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
- dEeleccat(k)=-k0*r(k)/ract**3
- enddo
- do k=1,3
- gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
- gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
- gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
- enddo
- if (energy_dec) write (iout,*) i,j,Evan1cat,Evan2cat,Eeleccat,&
- r012,rcal**6,ichargecat(itypi)*ichargecat(itypj)
+ Evan1cat=epscalc*(r012/(rcal**6))
+ Evan2cat=epscalc*2*(r06/(rcal**3))
+ Eeleccat=k0/ract
+ r7 = rcal**7
+ r4 = rcal**4
+ r(1)=xj
+ r(2)=yj
+ r(3)=zj
+ do k=1,3
+ dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
+ dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
+ dEeleccat(k)=-k0*r(k)/ract**3
+ enddo
+ do k=1,3
+ gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
+ gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
+ gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
+ enddo
+ if (energy_dec) write (iout,*) i,j,Evan1cat,Evan2cat,Eeleccat,&
+ r012,rcal**6,ichargecat(itypi)*ichargecat(itypj)
! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
- ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
+ ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
enddo
enddo
return
!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
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: escpho
eps_out=80.0d0
! sss_ele_cut=1.0d0
- itmp=0
- do i=1,4
- itmp=itmp+nres_molec(i)
- enddo
+ 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
! 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)
+ 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 )
- 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 = chi1cat(itypi,itypj)
- chis1 = chis1cat(itypi,itypj)
- chip1 = chipp1cat(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 = 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+nres)
- ctail(k,2)=c(k,j)
+ ctail(k,1)=c(k,i+nres)
+ ctail(k,2)=c(k,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)))
! 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)
! 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)
- CALL sc_angular
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ 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
+ 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
!#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
+ 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
dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
dbot = 12.0d0 * b4cav * bat * Lambf
dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
- dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
- dbot = 12.0d0 * b4cav * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
- dFdL = ((dtop * bot - top * dbot) / botsq)
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
+ 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)
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+nres))
! 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
+ isel = iabs(Qi) + 1 ! ion is always charged so iabs(Qj)
+ IF (isel.eq.0) THEN
!c! No charges - do nothing
- eheadtail = 0.0d0
+ eheadtail = 0.0d0
- ELSE IF (isel.eq.1) THEN
+ ELSE IF (isel.eq.1) THEN
!c! Nonpolar-charge interactions
- if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
- Qi=Qi*2
- Qij=Qij*2
- endif
- if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
- Qj=Qj*2
- Qij=Qij*2
- endif
+ 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
+ CALL enq_cat(epol)
+ eheadtail = epol
! eheadtail = 0.0d0
- ELSE IF (isel.eq.3) THEN
+ ELSE IF (isel.eq.3) THEN
!c! Dipole-charge interactions
- if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
- Qi=Qi*2
- Qij=Qij*2
- endif
- if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
- Qj=Qj*2
- Qij=Qij*2
- endif
- write(iout,*) "KURWA0",d1
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
+ write(iout,*) "KURWA0",d1
- CALL edq_cat(ecl, elj, epol)
- eheadtail = ECL + elj + epol
+ CALL edq_cat(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
! eheadtail = 0.0d0
- ELSE IF ((isel.eq.2)) THEN
+ ELSE IF ((isel.eq.2)) THEN
!c! Same charge-charge interaction ( +/+ or -/- )
- if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
- Qi=Qi*2
- Qij=Qij*2
- endif
- if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
- Qj=Qj*2
- Qij=Qij*2
- endif
+ 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
+ CALL eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
+ eheadtail = ECL + Egb + Epol + Fisocav + Elj
! eheadtail = 0.0d0
! ELSE IF ((isel.eq.2.and. &
!
! 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
+ evdw = evdw + Fcav + eheadtail
IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
- restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
- 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
- Equad,evdwij+Fcav+eheadtail,evdw
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+ Equad,evdwij+Fcav+eheadtail,evdw
! evdw = evdw + Fcav + eheadtail
! iF (nstate(itypi,itypj).eq.1) THEN
- CALL sc_grad_cat
+ CALL sc_grad_cat
! END IF
!c!-------------------------------------------------------------------
!c! NAPISY KONCOWE
- END DO ! j
+ 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
+ do i=ibond_start,ibond_end
! 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
+ 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)
+ 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 )
+ 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)
+ itypi = 10
+ itypj = itype(j,5)
! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
! sampling performed with amber package
! alf1 = 0.0d0
! alf2 = 0.0d0
! alf12 = 0.0d0
! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
- chi1 = chi1cat(itypi,itypj)
- chis1 = chis1cat(itypi,itypj)
- chip1 = chipp1cat(itypi,itypj)
+ chi1 = 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 = 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
!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)))
! 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)+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)
! 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)
- CALL sc_angular
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ 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
+ 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
!#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
+ gg(2) = fac
+ gg(3) = fac
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
-
- pom = 1.0d0 - chis1 * chis2 * sqom12
+ 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
+ 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)
+ 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 )
+ 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) )
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
!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
+ if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
+ Qi=Qi*2
+ Qij=Qij*2
+ endif
+ if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
+ Qj=Qj*2
+ Qij=Qij*2
+ endif
+ CALL edq_cat_pep(ecl, elj, epol)
+ eheadtail = ECL + elj + epol
! print *,"i,",i,eheadtail
! eheadtail = 0.0d0
- evdw = evdw + Fcav + eheadtail
+ evdw = evdw + Fcav + eheadtail
IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
- restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
- 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
- Equad,evdwij+Fcav+eheadtail,evdw
+ restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
+ 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
+ Equad,evdwij+Fcav+eheadtail,evdw
! evdw = evdw + Fcav + eheadtail
! iF (nstate(itypi,itypj).eq.1) THEN
- CALL sc_grad_cat_pep
+ CALL sc_grad_cat_pep
! END IF
!c!-------------------------------------------------------------------
!c! NAPISY KONCOWE
- END DO ! j
+ END DO ! j
END DO ! i
!c write (iout,*) "Number of loop steps in EGB:",ind
!c energy_dec=.false.
! 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,ecationcation
+ real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
+ dist_init,dist_temp,ecation_prot,rcal,rocal, &
+ Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
+ catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
+ wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
+ costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
+ Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
+ rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
+ opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
+ opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
+ Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip,&
+ ndiv,ndivi
+ real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
+ gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
+ dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
+ tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
+ v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
+ dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
+ dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
+ dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
+ dEvan1Cat
+ real(kind=8),dimension(6) :: vcatprm
+ ecation_prot=0.0d0
! first lets calculate interaction with peptide groups
- if (nres_molec(5).eq.0) return
- 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
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0ij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip
+ dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: escbase
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
+ sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
eps_out=80.0d0
escbase=0.0d0
! do i=1,nres_molec(1)
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1)) cycle
- itypi = itype(i,1)
- dxi = dc_norm(1,nres+i)
- dyi = dc_norm(2,nres+i)
- dzi = dc_norm(3,nres+i)
- dsci_inv = vbld_inv(i+nres)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
- itypj= itype(j,2)
- if (itype(j,2).eq.ntyp1_molec(2))cycle
- xj=c(1,j+nres)
- yj=c(2,j+nres)
- zj=c(3,j+nres)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- dxj = dc_norm( 1, nres+j )
- dyj = dc_norm( 2, nres+j )
- dzj = dc_norm( 3, nres+j )
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1)) cycle
+ itypi = itype(i,1)
+ dxi = dc_norm(1,nres+i)
+ dyi = dc_norm(2,nres+i)
+ dzi = dc_norm(3,nres+i)
+ dsci_inv = vbld_inv(i+nres)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
+ itypj= itype(j,2)
+ if (itype(j,2).eq.ntyp1_molec(2))cycle
+ xj=c(1,j+nres)
+ yj=c(2,j+nres)
+ zj=c(3,j+nres)
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
! print *,i,j,itypi,itypj
- d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
- d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
+ d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
+ d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
! d1i=0.0d0
! d1j=0.0d0
! BetaT = 1.0d0 / (298.0d0 * Rb)
! Gay-berne var's
- sig0ij = sigma_scbase( itypi,itypj )
- chi1 = chi_scbase( itypi, itypj,1 )
- chi2 = chi_scbase( itypi, itypj,2 )
+ sig0ij = sigma_scbase( itypi,itypj )
+ chi1 = chi_scbase( itypi, itypj,1 )
+ chi2 = chi_scbase( itypi, itypj,2 )
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
- chip1 = chipp_scbase( itypi, itypj,1 )
- chip2 = chipp_scbase( itypi, itypj,2 )
+ chi12 = chi1 * chi2
+ chip1 = chipp_scbase( itypi, itypj,1 )
+ chip2 = chipp_scbase( itypi, itypj,2 )
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
+ chip12 = chip1 * chip2
! not used by momo potential, but needed by sc_angular which is shared
! by all energy_potential subroutines
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
! a12sq = a12sq * a12sq
! charge of amino acid itypi is...
- chis1 = chis_scbase(itypi,itypj,1)
- chis2 = chis_scbase(itypi,itypj,2)
- chis12 = chis1 * chis2
- sig1 = sigmap1_scbase(itypi,itypj)
- sig2 = sigmap2_scbase(itypi,itypj)
+ chis1 = chis_scbase(itypi,itypj,1)
+ chis2 = chis_scbase(itypi,itypj,2)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_scbase(itypi,itypj)
+ sig2 = sigmap2_scbase(itypi,itypj)
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- b1 = alphasur_scbase(1,itypi,itypj)
+ b1 = alphasur_scbase(1,itypi,itypj)
! b1=0.0d0
- b2 = alphasur_scbase(2,itypi,itypj)
- b3 = alphasur_scbase(3,itypi,itypj)
- b4 = alphasur_scbase(4,itypi,itypj)
+ b2 = alphasur_scbase(2,itypi,itypj)
+ b3 = alphasur_scbase(3,itypi,itypj)
+ b4 = alphasur_scbase(4,itypi,itypj)
! used to determine whether we want to do quadrupole calculations
! used by Fgb
eps_in = epsintab_scbase(itypi,itypj)
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
+ chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!-------------------------------------------------------------------
! zero everything that should be zero'ed
evdwij = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
! print *,i,j,dscj_inv,dsci_inv
! rij holds 1/(distance of Calpha atoms)
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
!----------------------------
- CALL sc_angular
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = 1.0/rij - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_scbase(itypi,itypj)
+ rij_shift = 1.0/rij - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_scbase(itypi,itypj)
! c1 = 0.0d0
- c2 = fac * bb_scbase(itypi,itypj)
+ c2 = fac * bb_scbase(itypi,itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ evdwij = eps2rt * eps3rt * evdwij
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
! if (b2.gt.0.0) then
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
! write (*,*) "sparrow = ", sparrow
- Chif = 1.0d0/rij * sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1 * ( eagle + b2 * ChiLambf - b3 )
- bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
+ Chif = 1.0d0/rij * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1 * ( eagle + b2 * ChiLambf - b3 )
+ bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
! print *,i,j,Fcav
- dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
- dbot = 12.0d0 * b4 * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+ dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
+ dbot = 12.0d0 * b4 * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
! dFdR = 0.0d0
! write (*,*) "dFcav/dR = ", dFdR
- dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
- dbot = 12.0d0 * b4 * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
-
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
+ dbot = 12.0d0 * b4 * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
-
- ertail(1) = xj*rij
- ertail(2) = yj*rij
- ertail(3) = zj*rij
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
+
+ ertail(1) = xj*rij
+ ertail(2) = yj*rij
+ ertail(3) = zj*rij
! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
DO k = 1, 3
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
- pom = ertail(k)
+ pom = ertail(k)
!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
- - (( dFdR + gg(k) ) * pom)
+ gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
+ - (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! & - ( dFdR * pom )
- pom = ertail(k)
+ pom = ertail(k)
!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
- + (( dFdR + gg(k) ) * pom)
+ gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
+ + (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! & + ( dFdR * pom )
- gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
!c! & - ( dFdR * ertail(k))
- gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
+ gg(k) = 0.0d0
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
END DO
! endif
!Now dipole-dipole
- if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
+ if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
w1 = wdipdip_scbase(1,itypi,itypj)
w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
w3 = wdipdip_scbase(2,itypi,itypj)
fac = (om12 - 3.0d0 * om1 * om2)
c1 = (w1 / (Rhead**3.0d0)) * fac
c2 = (w2 / Rhead ** 6.0d0) &
- * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
c3= (w3/ Rhead ** 6.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
ECL = c1 - c2 + c3
!c! write (*,*) "w1 = ", w1
!c! write (*,*) "w2 = ", w2
!c! dECL/dr
c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
- * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
dGCLdR = c1 - c2 + c3
!c! dECL/dom1
c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
+ * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
dGCLdOM1 = c1 - c2 + c3
!c! dECL/dom2
c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
dGCLdOM2 = c1 - c2 + c3
!c! dECL/dom12
c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
dGCLdOM12 = c1 - c2 + c3
DO k= 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
+ erhead(k) = Rhead_distance(k)/Rhead
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
facd2 = d1j * vbld_inv(j+nres)
DO k = 1, 3
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
- - dGCLdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
- + dGCLdR * pom
-
- gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
- - dGCLdR * erhead(k)
- gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
- + dGCLdR * erhead(k)
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
+ - dGCLdR * pom
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
+ + dGCLdR * pom
+
+ gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
+ - dGCLdR * erhead(k)
+ gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
+ + dGCLdR * erhead(k)
END DO
endif
!now charge with dipole eg. ARG-dG
R1 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances tail is center of side-chain
- R1=R1+(c(k,j+nres)-chead(k,1))**2
+ R1=R1+(c(k,j+nres)-chead(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
sparrow = w1 * om1
hawk = w2 * (1.0d0 - sqom2)
Ecl = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ + 4.0d0 * hawk / Rhead**5.0d0
!c! dF/dom1
dGCLdOM1 = (w1) / (Rhead**2.0d0)
!c! dF/dom2
epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
! derivative of Epol is Gpol...
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdR1 = dPOLdFGB1 * dFGBdR1
! dPOLdR1 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
! facd1=0.0d0
! facd2=0.0d0
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
- - dGCLdR * pom &
- - dPOLdR1 * (erhead_tail(k,1))
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
+ - dGCLdR * pom &
+ - dPOLdR1 * (erhead_tail(k,1))
! & - dGLJdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
- + dGCLdR * pom &
- + dPOLdR1 * (erhead_tail(k,1))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
+ + dGCLdR * pom &
+ + dPOLdR1 * (erhead_tail(k,1))
! & + dGLJdR * pom
- gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
- - dGCLdR * erhead(k) &
- - dPOLdR1 * erhead_tail(k,1)
+ gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1)
! & - dGLJdR * erhead(k)
- gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
- + dGCLdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1)
+ gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
+ + dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1)
! & + dGLJdR * erhead(k)
END DO
! print *,i,j,evdwij,epol,Fcav,ECL
escbase=escbase+evdwij+epol+Fcav+ECL
call sc_grad_scbase
- enddo
+ enddo
enddo
return
real (kind=8) :: dcosom1(3),dcosom2(3)
eom1 = &
- eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der &
- + sigder * sigsq_om1 &
- + dCAVdOM1 &
- + dGCLdOM1 &
- + dPOLdOM1
+ eps2der * eps2rt_om1 &
+ - 2.0D0 * alf1 * eps3der &
+ + sigder * sigsq_om1 &
+ + dCAVdOM1 &
+ + dGCLdOM1 &
+ + dPOLdOM1
eom2 = &
- eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der &
- + sigder * sigsq_om2 &
- + dCAVdOM2 &
- + dGCLdOM2 &
- + dPOLdOM2
+ eps2der * eps2rt_om2 &
+ + 2.0D0 * alf2 * eps3der &
+ + sigder * sigsq_om2 &
+ + dCAVdOM2 &
+ + dGCLdOM2 &
+ + dPOLdOM2
eom12 = &
- evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der &
- + sigder *sigsq_om12 &
- + dCAVdOM12 &
- + dGCLdOM12
+ evdwij * eps1_om12 &
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der &
+ + sigder *sigsq_om12 &
+ + dCAVdOM12 &
+ + dGCLdOM12
! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
! gg(1),gg(2),"rozne"
DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
- gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
- + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
- + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
- gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
+ + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
+ + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
+ gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
END DO
RETURN
END SUBROUTINE sc_grad_scbase
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0ij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip
+ dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: epepbase
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
+ sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
eps_out=80.0d0
epepbase=0.0d0
! do i=1,nres_molec(1)-1
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
!C itypi = itype(i,1)
- dxi = dc_norm(1,i)
- dyi = dc_norm(2,i)
- dzi = dc_norm(3,i)
+ dxi = dc_norm(1,i)
+ dyi = dc_norm(2,i)
+ dzi = dc_norm(3,i)
! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
- dsci_inv = vbld_inv(i+1)/2.0
- xi=(c(1,i)+c(1,i+1))/2.0
- yi=(c(2,i)+c(2,i+1))/2.0
- zi=(c(3,i)+c(3,i+1))/2.0
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
- itypj= itype(j,2)
- if (itype(j,2).eq.ntyp1_molec(2))cycle
- xj=c(1,j+nres)
- yj=c(2,j+nres)
- zj=c(3,j+nres)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- dxj = dc_norm( 1, nres+j )
- dyj = dc_norm( 2, nres+j )
- dzj = dc_norm( 3, nres+j )
+ dsci_inv = vbld_inv(i+1)/2.0
+ xi=(c(1,i)+c(1,i+1))/2.0
+ yi=(c(2,i)+c(2,i+1))/2.0
+ zi=(c(3,i)+c(3,i+1))/2.0
+ call to_box(xi,yi,zi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
+ itypj= itype(j,2)
+ if (itype(j,2).eq.ntyp1_molec(2))cycle
+ xj=c(1,j+nres)
+ yj=c(2,j+nres)
+ zj=c(3,j+nres)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist_init=xj**2+yj**2+zj**2
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
! Gay-berne var's
- sig0ij = sigma_pepbase(itypj )
- chi1 = chi_pepbase(itypj,1 )
- chi2 = chi_pepbase(itypj,2 )
+ sig0ij = sigma_pepbase(itypj )
+ chi1 = chi_pepbase(itypj,1 )
+ chi2 = chi_pepbase(itypj,2 )
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
- chip1 = chipp_pepbase(itypj,1 )
- chip2 = chipp_pepbase(itypj,2 )
+ chi12 = chi1 * chi2
+ chip1 = chipp_pepbase(itypj,1 )
+ chip2 = chipp_pepbase(itypj,2 )
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
- chis1 = chis_pepbase(itypj,1)
- chis2 = chis_pepbase(itypj,2)
- chis12 = chis1 * chis2
- sig1 = sigmap1_pepbase(itypj)
- sig2 = sigmap2_pepbase(itypj)
+ chip12 = chip1 * chip2
+ chis1 = chis_pepbase(itypj,1)
+ chis2 = chis_pepbase(itypj,2)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_pepbase(itypj)
+ sig2 = sigmap2_pepbase(itypj)
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
DO k = 1,3
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = (c(k,i)+c(k,i+1))/2.0
+ chead(k,1) = (c(k,i)+c(k,i+1))/2.0
! + d1i * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres)
+ chead(k,2) = c(k, j+nres)
! + d1j * dc_norm(k, j+nres)
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
! print *,gvdwc_pepbase(k,i)
END DO
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
! alpha factors from Fcav/Gcav
- b1 = alphasur_pepbase(1,itypj)
+ b1 = alphasur_pepbase(1,itypj)
! b1=0.0d0
- b2 = alphasur_pepbase(2,itypj)
- b3 = alphasur_pepbase(3,itypj)
- b4 = alphasur_pepbase(4,itypj)
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ b2 = alphasur_pepbase(2,itypj)
+ b3 = alphasur_pepbase(3,itypj)
+ b4 = alphasur_pepbase(4,itypj)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
! print *,i,j,rrij
- rij = dsqrt(rrij)
+ rij = dsqrt(rrij)
!----------------------------
evdwij = 0.0d0
ECL = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
- CALL sc_angular
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
- rij_shift = 1.0/rij - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_pepbase(itypj)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
+ rij_shift = 1.0/rij - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_pepbase(itypj)
! c1 = 0.0d0
- c2 = fac * bb_pepbase(itypj)
+ c2 = fac * bb_pepbase(itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ evdwij = eps2rt * eps3rt * evdwij
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
! write (*,*) "sparrow = ", sparrow
- Chif = 1.0d0/rij * sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1 * ( eagle + b2 * ChiLambf - b3 )
- bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
+ Chif = 1.0d0/rij * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1 * ( eagle + b2 * ChiLambf - b3 )
+ bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
! print *,i,j,Fcav
- dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
- dbot = 12.0d0 * b4 * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+ dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
+ dbot = 12.0d0 * b4 * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
! dFdR = 0.0d0
! write (*,*) "dFcav/dR = ", dFdR
- dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
- dbot = 12.0d0 * b4 * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
-
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
+ dbot = 12.0d0 * b4 * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
- ertail(1) = xj*rij
- ertail(2) = yj*rij
- ertail(3) = zj*rij
+ ertail(1) = xj*rij
+ ertail(2) = yj*rij
+ ertail(3) = zj*rij
DO k = 1, 3
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
- pom = ertail(k)
+ pom = ertail(k)
!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
- - (( dFdR + gg(k) ) * pom)/2.0
+ gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
+ - (( dFdR + gg(k) ) * pom)/2.0
! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! & - ( dFdR * pom )
- pom = ertail(k)
+ pom = ertail(k)
!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
- + (( dFdR + gg(k) ) * pom)
+ gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
+ + (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! & + ( dFdR * pom )
- gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
- - (( dFdR + gg(k) ) * ertail(k))/2.0
+ gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
+ - (( dFdR + gg(k) ) * ertail(k))/2.0
! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
!c! & - ( dFdR * ertail(k))
- gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
+ gg(k) = 0.0d0
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
END DO
fac = (om12 - 3.0d0 * om1 * om2)
c1 = (w1 / (Rhead**3.0d0)) * fac
c2 = (w2 / Rhead ** 6.0d0) &
- * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
c3= (w3/ Rhead ** 6.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
ECL = c1 - c2 + c3
c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
- * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
+ * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
- * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
+ * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
dGCLdR = c1 - c2 + c3
!c! dECL/dom1
c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
+ * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
dGCLdOM1 = c1 - c2 + c3
!c! dECL/dom2
c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
dGCLdOM2 = c1 - c2 + c3
c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
dGCLdOM12 = c1 - c2 + c3
DO k= 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
+ erhead(k) = Rhead_distance(k)/Rhead
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
!+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
! - dGCLdR * pom
- pom = erhead(k)
+ pom = erhead(k)
!+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
- gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
- + dGCLdR * pom
+ gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
+ + dGCLdR * pom
- gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
- - dGCLdR * erhead(k)/2.0d0
+ gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
+ - dGCLdR * erhead(k)/2.0d0
! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
- gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
- - dGCLdR * erhead(k)/2.0d0
+ gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
+ - dGCLdR * erhead(k)/2.0d0
! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
- gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
- + dGCLdR * erhead(k)
+ gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
+ + dGCLdR * erhead(k)
END DO
! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
epepbase=epepbase+evdwij+Fcav+ECL
real (kind=8) :: dcosom1(3),dcosom2(3)
eom1 = &
- eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der &
- + sigder * sigsq_om1 &
- + dCAVdOM1 &
- + dGCLdOM1 &
- + dPOLdOM1
+ eps2der * eps2rt_om1 &
+ - 2.0D0 * alf1 * eps3der &
+ + sigder * sigsq_om1 &
+ + dCAVdOM1 &
+ + dGCLdOM1 &
+ + dPOLdOM1
eom2 = &
- eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der &
- + sigder * sigsq_om2 &
- + dCAVdOM2 &
- + dGCLdOM2 &
- + dPOLdOM2
+ eps2der * eps2rt_om2 &
+ + 2.0D0 * alf2 * eps3der &
+ + sigder * sigsq_om2 &
+ + dCAVdOM2 &
+ + dGCLdOM2 &
+ + dPOLdOM2
eom12 = &
- evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der &
- + sigder *sigsq_om12 &
- + dCAVdOM12 &
- + dGCLdOM12
+ evdwij * eps1_om12 &
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der &
+ + sigder *sigsq_om12 &
+ + dCAVdOM12 &
+ + dGCLdOM12
! om12=0.0
! eom12=0.0
! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
! 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
!el local variables
integer :: iint,itypi,itypi1,itypj,subchap
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
- real(kind=8) :: evdw,sig0ij
+ real(kind=8) :: evdw,sig0ij,aa,bb
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip,alpha_sco
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: escpho
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
+ sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
eps_out=80.0d0
escpho=0.0d0
! do i=1,nres_molec(1)
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1)) cycle
- itypi = itype(i,1)
- dxi = dc_norm(1,nres+i)
- dyi = dc_norm(2,nres+i)
- dzi = dc_norm(3,nres+i)
- dsci_inv = vbld_inv(i+nres)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
- itypj= itype(j,2)
- if ((itype(j,2).eq.ntyp1_molec(2)).or.&
- (itype(j+1,2).eq.ntyp1_molec(2))) cycle
- xj=(c(1,j)+c(1,j+1))/2.0
- yj=(c(2,j)+c(2,j+1))/2.0
- zj=(c(3,j)+c(3,j+1))/2.0
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1)) cycle
+ itypi = itype(i,1)
+ dxi = dc_norm(1,nres+i)
+ dyi = dc_norm(2,nres+i)
+ dzi = dc_norm(3,nres+i)
+ dsci_inv = vbld_inv(i+nres)
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
+ itypj= itype(j,2)
+ if ((itype(j,2).eq.ntyp1_molec(2)).or.&
+ (itype(j+1,2).eq.ntyp1_molec(2))) cycle
+ xj=(c(1,j)+c(1,j+1))/2.0
+ yj=(c(2,j)+c(2,j+1))/2.0
+ zj=(c(3,j)+c(3,j+1))/2.0
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
dxj = dc_norm( 1,j )
- dyj = dc_norm( 2,j )
- dzj = dc_norm( 3,j )
- dscj_inv = vbld_inv(j+1)
+ dyj = dc_norm( 2,j )
+ dzj = dc_norm( 3,j )
+ dscj_inv = vbld_inv(j+1)
! Gay-berne var's
- sig0ij = sigma_scpho(itypi )
- chi1 = chi_scpho(itypi,1 )
- chi2 = chi_scpho(itypi,2 )
+ sig0ij = sigma_scpho(itypi )
+ chi1 = chi_scpho(itypi,1 )
+ chi2 = chi_scpho(itypi,2 )
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
- chip1 = chipp_scpho(itypi,1 )
- chip2 = chipp_scpho(itypi,2 )
+ chi12 = chi1 * chi2
+ chip1 = chipp_scpho(itypi,1 )
+ chip2 = chipp_scpho(itypi,2 )
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
- chis1 = chis_scpho(itypi,1)
- chis2 = chis_scpho(itypi,2)
- chis12 = chis1 * chis2
- sig1 = sigmap1_scpho(itypi)
- sig2 = sigmap2_scpho(itypi)
+ chip12 = chip1 * chip2
+ chis1 = chis_scpho(itypi,1)
+ chis2 = chis_scpho(itypi,2)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_scpho(itypi)
+ sig2 = sigmap2_scpho(itypi)
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
- b1 = alphasur_scpho(1,itypi)
+ b1 = alphasur_scpho(1,itypi)
! b1=0.0d0
- b2 = alphasur_scpho(2,itypi)
- b3 = alphasur_scpho(3,itypi)
- b4 = alphasur_scpho(4,itypi)
+ b2 = alphasur_scpho(2,itypi)
+ b3 = alphasur_scpho(3,itypi)
+ b4 = alphasur_scpho(4,itypi)
! used to determine whether we want to do quadrupole calculations
! used by Fgb
eps_in = epsintab_scpho(itypi)
! write (*,*) "eps_inout_fac = ", eps_inout_fac
!-------------------------------------------------------------------
! tail location and distance calculations
- d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
- d1j = 0.0
+ d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
+ d1j = 0.0
DO k = 1,3
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
- chead(k,2) = (c(k, j) + c(k, j+1))/2.0
+ chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
+ chead(k,2) = (c(k, j) + c(k, j+1))/2.0
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
Rhead_sq=Rhead**2.0
!-------------------------------------------------------------------
! zero everything that should be zero'ed
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+1)/2.0
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+1)/2.0
!dhead_scbasej(itypi,itypj)
! print *,i,j,dscj_inv,dsci_inv
! rij holds 1/(distance of Calpha atoms)
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
!----------------------------
- CALL sc_angular
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = 1.0/rij - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_scpho(itypi)
+ rij_shift = 1.0/rij - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_scpho(itypi)
! c1 = 0.0d0
- c2 = fac * bb_scpho(itypi)
+ c2 = fac * bb_scpho(itypi)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ evdwij = eps2rt * eps3rt * evdwij
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
! write (*,*) "sparrow = ", sparrow
- Chif = 1.0d0/rij * sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1 * ( eagle + b2 * ChiLambf - b3 )
- bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
- dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
- dbot = 12.0d0 * b4 * bat * Lambf
- dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
+ Chif = 1.0d0/rij * sparrow
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1 * ( eagle + b2 * ChiLambf - b3 )
+ bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
+ dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
+ dbot = 12.0d0 * b4 * bat * Lambf
+ dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
! dFdR = 0.0d0
! write (*,*) "dFcav/dR = ", dFdR
- dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
- dbot = 12.0d0 * b4 * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
-
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
+ dbot = 12.0d0 * b4 * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
+
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
- ertail(1) = xj*rij
- ertail(2) = yj*rij
- ertail(3) = zj*rij
+ ertail(1) = xj*rij
+ ertail(2) = yj*rij
+ ertail(3) = zj*rij
DO k = 1, 3
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
- pom = ertail(k)
+ pom = ertail(k)
! print *,pom,gg(k),dFdR
!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
- - (( dFdR + gg(k) ) * pom)
+ gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
+ - (( dFdR + gg(k) ) * pom)
! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! & - ( dFdR * pom )
! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! & + ( dFdR * pom )
- gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
+ gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
!c! & - ( dFdR * ertail(k))
- gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))/2.0
+ gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))/2.0
- gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
- + (( dFdR + gg(k) ) * ertail(k))/2.0
+ gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
+ + (( dFdR + gg(k) ) * ertail(k))/2.0
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
- ENDDO
+ gg(k) = 0.0d0
+ ENDDO
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
! alphapol1 = alphapol_scpho(itypi)
Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead
!c! derivative of Ecl is Gcl...
dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* &
- (Rhead*alpha_sco+1) ) / Rhead_sq
+ (Rhead*alpha_sco+1) ) / Rhead_sq
if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij
else if (wqdip_scpho(2,itypi).gt.0.0d0) then
w1 = wqdip_scpho(1,itypi)
sparrow = w1 * om1
hawk = w2 * (1.0d0 - sqom2)
Ecl = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
- 1.0/rij,sparrow
+ 1.0/rij,sparrow
!c! derivative of ecl is Gcl
!c! dF/dr part
dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ + 4.0d0 * hawk / Rhead**5.0d0
!c! dF/dom1
dGCLdOM1 = (w1) / (Rhead**2.0d0)
!c! dF/dom2
R1 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances tail is center of side-chain
- R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
+ R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
! derivative of Epol is Gpol...
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdR1 = dPOLdFGB1 * dFGBdR1
! dPOLdR1 = 0.0d0
! dPOLdOM1 = 0.0d0
dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
dPOLdOM2 = 0.0
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
! facd1=0.0d0
! facd2=0.0d0
! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
! pom,(erhead_tail(k,1))
! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
- gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
- - dGCLdR * pom &
- - dPOLdR1 * (erhead_tail(k,1))
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
+ - dGCLdR * pom &
+ - dPOLdR1 * (erhead_tail(k,1))
! & - dGLJdR * pom
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
! + dGCLdR * pom &
! + dPOLdR1 * (erhead_tail(k,1))
! & + dGLJdR * pom
- gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
- - dGCLdR * erhead(k) &
- - dPOLdR1 * erhead_tail(k,1)
+ gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
+ - dGCLdR * erhead(k) &
+ - dPOLdR1 * erhead_tail(k,1)
! & - dGLJdR * erhead(k)
- gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
- + (dGCLdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1))/2.0
- gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
- + (dGCLdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1))/2.0
+ gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
+ + (dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1))/2.0
+ gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
+ + (dGCLdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1))/2.0
! & + dGLJdR * erhead(k)
! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
END DO
! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
- "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
+ "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
escpho=escpho+evdwij+epol+Fcav+ECL
call sc_grad_scpho
- enddo
+ enddo
enddo
real (kind=8) :: dcosom1(3),dcosom2(3)
eom1 = &
- eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der &
- + sigder * sigsq_om1 &
- + dCAVdOM1 &
- + dGCLdOM1 &
- + dPOLdOM1
+ eps2der * eps2rt_om1 &
+ - 2.0D0 * alf1 * eps3der &
+ + sigder * sigsq_om1 &
+ + dCAVdOM1 &
+ + dGCLdOM1 &
+ + dPOLdOM1
eom2 = &
- eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der &
- + sigder * sigsq_om2 &
- + dCAVdOM2 &
- + dGCLdOM2 &
- + dPOLdOM2
+ eps2der * eps2rt_om2 &
+ + 2.0D0 * alf2 * eps3der &
+ + sigder * sigsq_om2 &
+ + dCAVdOM2 &
+ + dGCLdOM2 &
+ + dPOLdOM2
eom12 = &
- evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der &
- + sigder *sigsq_om12 &
- + dCAVdOM12 &
- + dGCLdOM12
+ evdwij * eps1_om12 &
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der &
+ + sigder *sigsq_om12 &
+ + dCAVdOM12 &
+ + dGCLdOM12
! om12=0.0
! eom12=0.0
! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
! gg(1),gg(2),"rozne"
DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
- gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
- + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
- *dscj_inv*2.0 &
- - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
- - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
- *dscj_inv*2.0 &
- + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
- + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
+ + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
+ *dscj_inv*2.0 &
+ - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
+ gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
+ - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
+ *dscj_inv*2.0 &
+ + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
+ gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
+ + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
! print *,eom12,eom2,om12,om2
!eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
+ gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
END DO
RETURN
END SUBROUTINE sc_grad_scpho
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
real(kind=8) :: evdw,sig0ij
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip
+ dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: epeppho
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
- sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
- Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
- dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
- r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
- dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
- sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
+ sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
+ Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
+ dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
+ r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
+ dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
+ sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
real(kind=8),dimension(3,2)::chead,erhead_tail
real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
integer troll
real (kind=8) :: dcosom1(3),dcosom2(3)
epeppho=0.0d0
! do i=1,nres_molec(1)
- do i=ibond_start,ibond_end
- if (itype(i,1).eq.ntyp1_molec(1)) cycle
- itypi = itype(i,1)
- dsci_inv = vbld_inv(i+1)/2.0
- dxi = dc_norm(1,i)
- dyi = dc_norm(2,i)
- dzi = dc_norm(3,i)
- xi=(c(1,i)+c(1,i+1))/2.0
- yi=(c(2,i)+c(2,i+1))/2.0
- zi=(c(3,i)+c(3,i+1))/2.0
- xi=mod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=mod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=mod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
- do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
- itypj= itype(j,2)
- if ((itype(j,2).eq.ntyp1_molec(2)).or.&
- (itype(j+1,2).eq.ntyp1_molec(2))) cycle
- xj=(c(1,j)+c(1,j+1))/2.0
- yj=(c(2,j)+c(2,j+1))/2.0
- zj=(c(3,j)+c(3,j+1))/2.0
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
- dxj = dc_norm( 1,j )
- dyj = dc_norm( 2,j )
- dzj = dc_norm( 3,j )
- dscj_inv = vbld_inv(j+1)/2.0
+ do i=ibond_start,ibond_end
+ if (itype(i,1).eq.ntyp1_molec(1)) cycle
+ itypi = itype(i,1)
+ dsci_inv = vbld_inv(i+1)/2.0
+ dxi = dc_norm(1,i)
+ dyi = dc_norm(2,i)
+ dzi = dc_norm(3,i)
+ xi=(c(1,i)+c(1,i+1))/2.0
+ yi=(c(2,i)+c(2,i+1))/2.0
+ zi=(c(3,i)+c(3,i+1))/2.0
+ call to_box(xi,yi,zi)
+
+ do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
+ itypj= itype(j,2)
+ if ((itype(j,2).eq.ntyp1_molec(2)).or.&
+ (itype(j+1,2).eq.ntyp1_molec(2))) cycle
+ xj=(c(1,j)+c(1,j+1))/2.0
+ yj=(c(2,j)+c(2,j+1))/2.0
+ zj=(c(3,j)+c(3,j+1))/2.0
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+
+ dist_init=xj**2+yj**2+zj**2
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
+ dxj = dc_norm( 1,j )
+ dyj = dc_norm( 2,j )
+ dzj = dc_norm( 3,j )
+ dscj_inv = vbld_inv(j+1)/2.0
! Gay-berne var's
- sig0ij = sigma_peppho
+ sig0ij = sigma_peppho
! chi1=0.0d0
! chi2=0.0d0
- chi12 = chi1 * chi2
+ chi12 = chi1 * chi2
! chip1=0.0d0
! chip2=0.0d0
- chip12 = chip1 * chip2
+ chip12 = chip1 * chip2
! chis1 = 0.0d0
! chis2 = 0.0d0
- chis12 = chis1 * chis2
- sig1 = sigmap1_peppho
- sig2 = sigmap2_peppho
+ chis12 = chis1 * chis2
+ sig1 = sigmap1_peppho
+ sig2 = sigmap2_peppho
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig1 = ", sig1
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- b1 = alphasur_peppho(1)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ b1 = alphasur_peppho(1)
! b1=0.0d0
- b2 = alphasur_peppho(2)
- b3 = alphasur_peppho(3)
- b4 = alphasur_peppho(4)
- CALL sc_angular
+ b2 = alphasur_peppho(2)
+ b3 = alphasur_peppho(3)
+ b4 = alphasur_peppho(4)
+ CALL sc_angular
sqom1=om1*om1
evdwij = 0.0d0
ECL = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- rij_shift = rij
- fac = rij_shift**expon
- c1 = fac * fac * aa_peppho
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ rij_shift = rij
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_peppho
! c1 = 0.0d0
- c2 = fac * bb_peppho
+ c2 = fac * bb_peppho
! c2 = 0.0d0
- evdwij = c1 + c2
+ evdwij = c1 + c2
! Now cavity....................
eagle = dsqrt(1.0/rij_shift)
top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
- bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
- botsq = bot * bot
- Fcav = top / bot
- dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
- dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
- dFdR = ((dtop * bot - top * dbot) / botsq)
+ bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
+ botsq = bot * bot
+ Fcav = top / bot
+ dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
+ dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
+ dFdR = ((dtop * bot - top * dbot) / botsq)
w1 = wqdip_peppho(1)
w2 = wqdip_peppho(2)
! w1=0.0d0
sparrow = w1 * om1
hawk = w2 * (1.0d0 - sqom1)
Ecl = sparrow * rij_shift**2.0d0 &
- - hawk * rij_shift**4.0d0
+ - hawk * rij_shift**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
! rij_shift=5.0
dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
- + 4.0d0 * hawk * rij_shift**5.0d0
+ + 4.0d0 * hawk * rij_shift**5.0d0
!c! dF/dom1
dGCLdOM1 = (w1) * (rij_shift**2.0d0)
!c! dF/dom2
eom1 = dGCLdOM1+dGCLdOM2
eom2 = 0.0
- fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
+ fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
! fac=0.0
- gg(1) = fac*xj*rij
- gg(2) = fac*yj*rij
- gg(3) = fac*zj*rij
- do k=1,3
- gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
- gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
- gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
- gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
- gg(k)=0.0
- enddo
+ gg(1) = fac*xj*rij
+ gg(2) = fac*yj*rij
+ gg(3) = fac*zj*rij
+ do k=1,3
+ gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
+ gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
+ gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
+ gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
+ gg(k)=0.0
+ enddo
DO k = 1, 3
- dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
- dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
- gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
+ dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
+ dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
+ gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
+ gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
- gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
- - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
- gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
- + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
- enddo
+ gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
+ - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+ gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
+ + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
+ enddo
epeppho=epeppho+evdwij+Fcav+ECL
! print *,i,j,evdwij,Fcav,ECL,rij_shift
enddo
!el local variables
integer :: iint,itypi1,subchap,isel
real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
- real(kind=8) :: evdw
+ real(kind=8) :: evdw,aa,bb
real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
- dist_temp, dist_init,ssgradlipi,ssgradlipj, &
- sslipi,sslipj,faclip,alpha_sco
+ dist_temp, dist_init,ssgradlipi,ssgradlipj, &
+ sslipi,sslipj,faclip,alpha_sco
integer :: ii
real(kind=8) :: fracinbuf
real (kind=8) :: escpho
real (kind=8),dimension(4):: ener
real(kind=8) :: b1,b2,egb
real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
- Lambf,&
- Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
- dFdOM2,dFdL,dFdOM12,&
- federmaus,&
- d1i,d1j
+ Lambf,&
+ Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
+ dFdOM2,dFdL,dFdOM12,&
+ federmaus,&
+ d1i,d1j
! real(kind=8),dimension(3,2)::erhead_tail
! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
real(kind=8) :: facd4, adler, Fgb, facd3
! print *,"EVDW KURW",evdw,nres
do i=iatsc_s,iatsc_e
! print *,"I am in EVDW",i
- itypi=iabs(itype(i,1))
+ itypi=iabs(itype(i,1))
! if (i.ne.47) cycle
- if (itypi.eq.ntyp1) cycle
- itypi1=iabs(itype(i+1,1))
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- xi=dmod(xi,boxxsize)
- if (xi.lt.0) xi=xi+boxxsize
- yi=dmod(yi,boxysize)
- if (yi.lt.0) yi=yi+boxysize
- zi=dmod(zi,boxzsize)
- if (zi.lt.0) zi=zi+boxzsize
-
+ if (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)
if ((zi.gt.bordlipbot) &
- .and.(zi.lt.bordliptop)) then
+ .and.(zi.lt.bordliptop)) then
!C the energy transfer exist
- if (zi.lt.buflipbot) then
+ if (zi.lt.buflipbot) then
!C what fraction I am in
- fracinbuf=1.0d0- &
- ((zi-bordlipbot)/lipbufthick)
+ 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
+ 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
+ sslipi=0.0d0
+ ssgradlipi=0.0
endif
! print *, sslipi,ssgradlipi
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
+ dxi=dc_norm(1,nres+i)
+ dyi=dc_norm(2,nres+i)
+ dzi=dc_norm(3,nres+i)
! dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
+ dsci_inv=vbld_inv(i+nres)
! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
!
! Calculate SC interaction energy.
!
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
! print *,"JA PIER",i,j,iint,istart(i,iint),iend(i,iint)
- IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
- call dyn_ssbond_ene(i,j,evdwij)
- evdw=evdw+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
- 'evdw',i,j,evdwij,' ss'
+ IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
+ call dyn_ssbond_ene(i,j,evdwij)
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
+ 'evdw',i,j,evdwij,' ss'
! if (energy_dec) write (iout,*) &
! 'evdw',i,j,evdwij,' ss'
- do k=j+1,iend(i,iint)
+ do k=j+1,iend(i,iint)
!C search over all next residues
- if (dyn_ss_mask(k)) then
+ if (dyn_ss_mask(k)) then
!C check if they are cysteins
!C write(iout,*) 'k=',k
!c write(iout,*) "PRZED TRI", evdwij
! evdwij_przed_tri=evdwij
- call triple_ssbond_ene(i,j,k,evdwij)
+ call triple_ssbond_ene(i,j,k,evdwij)
!c if(evdwij_przed_tri.ne.evdwij) then
!c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
!c endif
!c write(iout,*) "PO TRI", evdwij
!C call the energy function that removes the artifical triple disulfide
!C bond the soubroutine is located in ssMD.F
- evdw=evdw+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
- 'evdw',i,j,evdwij,'tss'
- endif!dyn_ss_mask(k)
- enddo! k
- ELSE
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
+ 'evdw',i,j,evdwij,'tss'
+ endif!dyn_ss_mask(k)
+ enddo! k
+ ELSE
!el ind=ind+1
- itypj=iabs(itype(j,1))
- if (itypj.eq.ntyp1) cycle
- CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
+ itypj=iabs(itype(j,1))
+ if (itypj.eq.ntyp1) cycle
+ CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
! if (j.ne.78) cycle
! dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- xj=c(1,j+nres)
- yj=c(2,j+nres)
- zj=c(3,j+nres)
- xj=dmod(xj,boxxsize)
- if (xj.lt.0) xj=xj+boxxsize
- yj=dmod(yj,boxysize)
- if (yj.lt.0) yj=yj+boxysize
- zj=dmod(zj,boxzsize)
- if (zj.lt.0) zj=zj+boxzsize
- dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- xj_safe=xj
- yj_safe=yj
- zj_safe=zj
- subchap=0
-
- do xshift=-1,1
- do yshift=-1,1
- do zshift=-1,1
- xj=xj_safe+xshift*boxxsize
- yj=yj_safe+yshift*boxysize
- zj=zj_safe+zshift*boxzsize
- dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
- if(dist_temp.lt.dist_init) then
- dist_init=dist_temp
- xj_temp=xj
- yj_temp=yj
- zj_temp=zj
- subchap=1
- endif
- enddo
- enddo
- enddo
- if (subchap.eq.1) then
- xj=xj_temp-xi
- yj=yj_temp-yi
- zj=zj_temp-zi
- else
- xj=xj_safe-xi
- yj=yj_safe-yi
- zj=zj_safe-zi
- endif
- dxj = dc_norm( 1, nres+j )
- dyj = dc_norm( 2, nres+j )
- dzj = dc_norm( 3, nres+j )
+ dscj_inv=vbld_inv(j+nres)
+ xj=c(1,j+nres)
+ yj=c(2,j+nres)
+ zj=c(3,j+nres)
+ call to_box(xj,yj,zj)
+ call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+ aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
+ +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dxj = dc_norm( 1, nres+j )
+ dyj = dc_norm( 2, nres+j )
+ dzj = dc_norm( 3, nres+j )
! print *,i,j,itypi,itypj
! d1i=0.0d0
! d1j=0.0d0
! chip2=0.0d0
! not used by momo potential, but needed by sc_angular which is shared
! by all energy_potential subroutines
- alf1 = 0.0d0
- alf2 = 0.0d0
- alf12 = 0.0d0
- a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
+ alf1 = 0.0d0
+ alf2 = 0.0d0
+ alf12 = 0.0d0
+ a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
! a12sq = a12sq * a12sq
! charge of amino acid itypi is...
- chis1 = chis(itypi,itypj)
- chis2 = chis(itypj,itypi)
- chis12 = chis1 * chis2
- sig1 = sigmap1(itypi,itypj)
- sig2 = sigmap2(itypi,itypj)
+ chis1 = chis(itypi,itypj)
+ chis2 = chis(itypj,itypi)
+ chis12 = chis1 * chis2
+ sig1 = sigmap1(itypi,itypj)
+ sig2 = sigmap2(itypi,itypj)
! write (*,*) "sig1 = ", sig1
! chis1=0.0
! chis2=0.0
! sig2=0.0
! write (*,*) "sig2 = ", sig2
! alpha factors from Fcav/Gcav
- b1cav = alphasur(1,itypi,itypj)
+ b1cav = alphasur(1,itypi,itypj)
! b1cav=0.0d0
- b2cav = alphasur(2,itypi,itypj)
- b3cav = alphasur(3,itypi,itypj)
- b4cav = alphasur(4,itypi,itypj)
+ b2cav = alphasur(2,itypi,itypj)
+ b3cav = alphasur(3,itypi,itypj)
+ b4cav = alphasur(4,itypi,itypj)
! used to determine whether we want to do quadrupole calculations
eps_in = epsintab(itypi,itypj)
if (eps_in.eq.0.0) eps_in=1.0
-
+
eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
Rtail = 0.0d0
! dtail(1,itypi,itypj)=0.0
! dtail(2,itypi,itypj)=0.0
DO k = 1, 3
- ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
- ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
+ ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
+ ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
END DO
!c! tail distances will be themselves usefull elswhere
!c1 (in Gcav, for example)
Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
Rtail = dsqrt( &
- (Rtail_distance(1)*Rtail_distance(1)) &
- + (Rtail_distance(2)*Rtail_distance(2)) &
- + (Rtail_distance(3)*Rtail_distance(3)))
+ (Rtail_distance(1)*Rtail_distance(1)) &
+ + (Rtail_distance(2)*Rtail_distance(2)) &
+ + (Rtail_distance(3)*Rtail_distance(3)))
! write (*,*) "eps_inout_fac = ", eps_inout_fac
!-------------------------------------------------------------------
! location of polar head is computed by taking hydrophobic centre
! and moving by a d1 * dc_norm vector
! see unres publications for very informative images
- chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
! distance
! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
END DO
! pitagoras (root of sum of squares)
Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
!-------------------------------------------------------------------
! zero everything that should be zero'ed
evdwij = 0.0d0
dGCLdOM12 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = 0.0d0
- Fcav = 0.0d0
- dFdR = 0.0d0
- dCAVdOM1 = 0.0d0
- dCAVdOM2 = 0.0d0
- dCAVdOM12 = 0.0d0
- dscj_inv = vbld_inv(j+nres)
+ Fcav = 0.0d0
+ dFdR = 0.0d0
+ dCAVdOM1 = 0.0d0
+ dCAVdOM2 = 0.0d0
+ dCAVdOM12 = 0.0d0
+ dscj_inv = vbld_inv(j+nres)
! print *,i,j,dscj_inv,dsci_inv
! rij holds 1/(distance of Calpha atoms)
- rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
- rij = dsqrt(rrij)
+ rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
+ rij = dsqrt(rrij)
!----------------------------
- CALL sc_angular
+ CALL sc_angular
! this should be in elgrad_init but om's are calculated by sc_angular
! which in turn is used by older potentials
! om = omega, sqom = om^2
- sqom1 = om1 * om1
- sqom2 = om2 * om2
- sqom12 = om12 * om12
+ sqom1 = om1 * om1
+ sqom2 = om2 * om2
+ sqom12 = om12 * om12
! now we calculate EGB - Gey-Berne
! It will be summed up in evdwij and saved in evdw
- sigsq = 1.0D0 / sigsq
- sig = sig0ij * dsqrt(sigsq)
+ sigsq = 1.0D0 / sigsq
+ sig = sig0ij * dsqrt(sigsq)
! rij_shift = 1.0D0 / rij - sig + sig0ij
- rij_shift = Rtail - sig + sig0ij
- IF (rij_shift.le.0.0D0) THEN
- evdw = 1.0D20
- RETURN
- END IF
- sigder = -sig * sigsq
- rij_shift = 1.0D0 / rij_shift
- fac = rij_shift**expon
- c1 = fac * fac * aa_aq(itypi,itypj)
+ rij_shift = Rtail - sig + sig0ij
+ IF (rij_shift.le.0.0D0) THEN
+ evdw = 1.0D20
+ RETURN
+ END IF
+ sigder = -sig * sigsq
+ rij_shift = 1.0D0 / rij_shift
+ fac = rij_shift**expon
+ c1 = fac * fac * aa_aq(itypi,itypj)
! print *,"ADAM",aa_aq(itypi,itypj)
! c1 = 0.0d0
- c2 = fac * bb_aq(itypi,itypj)
+ c2 = fac * bb_aq(itypi,itypj)
! c2 = 0.0d0
- evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
- eps2der = eps3rt * evdwij
- eps3der = eps2rt * evdwij
+ evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
+ eps2der = eps3rt * evdwij
+ eps3der = eps2rt * evdwij
! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
- evdwij = eps2rt * eps3rt * evdwij
+ evdwij = eps2rt * eps3rt * evdwij
!#ifdef TSCSC
! IF (bb_aq(itypi,itypj).gt.0) THEN
! evdw_p = evdw_p + evdwij
! evdw_m = evdw_m + evdwij
! END IF
!#else
- evdw = evdw &
- + evdwij
+ evdw = evdw &
+ + evdwij
!#endif
- c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
- fac = -expon * (c1 + evdwij) * rij_shift
- sigder = fac * sigder
+ c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
+ fac = -expon * (c1 + evdwij) * rij_shift
+ sigder = fac * sigder
! fac = rij * fac
! Calculate distance derivative
- gg(1) = fac
- gg(2) = fac
- gg(3) = fac
+ gg(1) = fac
+ gg(2) = fac
+ gg(3) = fac
! if (b2.gt.0.0) then
- fac = chis1 * sqom1 + chis2 * sqom2 &
- - 2.0d0 * chis12 * om1 * om2 * om12
+ fac = chis1 * sqom1 + chis2 * sqom2 &
+ - 2.0d0 * chis12 * om1 * om2 * om12
! we will use pom later in Gcav, so dont mess with it!
- pom = 1.0d0 - chis1 * chis2 * sqom12
- Lambf = (1.0d0 - (fac / pom))
+ pom = 1.0d0 - chis1 * chis2 * sqom12
+ Lambf = (1.0d0 - (fac / pom))
! print *,"fac,pom",fac,pom,Lambf
- Lambf = dsqrt(Lambf)
- sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
+ Lambf = dsqrt(Lambf)
+ sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
! print *,"sig1,sig2",sig1,sig2,itypi,itypj
! write (*,*) "sparrow = ", sparrow
- Chif = Rtail * sparrow
+ Chif = Rtail * sparrow
! print *,"rij,sparrow",rij , sparrow
- ChiLambf = Chif * Lambf
- eagle = dsqrt(ChiLambf)
- bat = ChiLambf ** 11.0d0
- top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
- bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
- botsq = bot * bot
+ ChiLambf = Chif * Lambf
+ eagle = dsqrt(ChiLambf)
+ bat = ChiLambf ** 11.0d0
+ top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
+ bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
+ botsq = bot * bot
! print *,top,bot,"bot,top",ChiLambf,Chif
- Fcav = top / bot
+ Fcav = top / bot
dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
dbot = 12.0d0 * b4cav * bat * Lambf
dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
- dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
- dbot = 12.0d0 * b4cav * bat * Chif
- eagle = Lambf * pom
- dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
- dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
- dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
- * (chis2 * om2 * om12 - om1) / (eagle * pom)
+ dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
+ dbot = 12.0d0 * b4cav * bat * Chif
+ eagle = Lambf * pom
+ dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
+ dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
+ dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
+ * (chis2 * om2 * om12 - om1) / (eagle * pom)
- dFdL = ((dtop * bot - top * dbot) / botsq)
+ dFdL = ((dtop * bot - top * dbot) / botsq)
! dFdL = 0.0d0
- dCAVdOM1 = dFdL * ( dFdOM1 )
- dCAVdOM2 = dFdL * ( dFdOM2 )
- dCAVdOM12 = dFdL * ( dFdOM12 )
+ dCAVdOM1 = dFdL * ( dFdOM1 )
+ dCAVdOM2 = dFdL * ( dFdOM2 )
+ dCAVdOM12 = dFdL * ( dFdOM12 )
DO k= 1, 3
- ertail(k) = Rtail_distance(k)/Rtail
+ ertail(k) = Rtail_distance(k)/Rtail
END DO
erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
DO k = 1, 3
!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
- pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
- gvdwx(k,i) = gvdwx(k,i) &
- - (( dFdR + gg(k) ) * pom)
+ pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i) &
+ - (( dFdR + gg(k) ) * pom)
!c! & - ( dFdR * pom )
- pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
- gvdwx(k,j) = gvdwx(k,j) &
- + (( dFdR + gg(k) ) * pom)
+ pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j) &
+ + (( dFdR + gg(k) ) * pom)
!c! & + ( dFdR * pom )
- gvdwc(k,i) = gvdwc(k,i) &
- - (( dFdR + gg(k) ) * ertail(k))
+ gvdwc(k,i) = gvdwc(k,i) &
+ - (( dFdR + gg(k) ) * ertail(k))
!c! & - ( dFdR * ertail(k))
- gvdwc(k,j) = gvdwc(k,j) &
- + (( dFdR + gg(k) ) * ertail(k))
+ gvdwc(k,j) = gvdwc(k,j) &
+ + (( dFdR + gg(k) ) * ertail(k))
!c! & + ( dFdR * ertail(k))
- gg(k) = 0.0d0
+ gg(k) = 0.0d0
! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
END DO
!c! Compute head-head and head-tail energies for each state
- isel = iabs(Qi) + iabs(Qj)
+ isel = iabs(Qi) + iabs(Qj)
! double charge for Phophorylated! itype - 25,27,27
! if ((itype(i).eq.27).or.(itype(i).eq.26).or.(itype(i).eq.25)) then
! Qi=Qi*2
! endif
! isel=0
- IF (isel.eq.0) THEN
+ IF (isel.eq.0) THEN
!c! No charges - do nothing
- eheadtail = 0.0d0
+ eheadtail = 0.0d0
- ELSE IF (isel.eq.4) THEN
+ ELSE IF (isel.eq.4) THEN
!c! Calculate dipole-dipole interactions
- CALL edd(ecl)
- eheadtail = ECL
+ CALL edd(ecl)
+ eheadtail = ECL
! eheadtail = 0.0d0
- ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
+ ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
!c! Charge-nonpolar interactions
- 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
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
! 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)
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
!c!-------------------------------------------------------------------
(( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
!c! epol = 0.0d0
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
- / ( 2.0d0 * fgb1 )
+ / ( 2.0d0 * fgb1 )
dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
- / ( 2.0d0 * fgb2 )
+ / ( 2.0d0 * fgb2 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
- * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
- * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
+ * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
dPOLdR1 = dPOLdFGB1 * dFGBdR1
!c! dPOLdR1 = 0.0d0
dPOLdR2 = dPOLdFGB2 * dFGBdR2
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
!c!-------------------------------------------------------------------
!c! Return the results
!c! These things do the dRdX derivatives, that is
!c! distance to function that changes with LOCATION (of the interaction
!c! site)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
!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)))
+
+ 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
- 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
+
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dGCLdR * erhead(k)&
+ - dGGBdR * erhead(k)&
+ - dGCVdR * erhead(k)&
+ - dPOLdR1 * erhead_tail(k,1)&
+ - dPOLdR2 * erhead_tail(k,2)&
+ - dGLJdR * erhead(k)
+
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dGCLdR * erhead(k) &
+ + dGGBdR * erhead(k) &
+ + dGCVdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dPOLdR2 * erhead_tail(k,2)&
+ + dGLJdR * erhead(k)
END DO
RETURN
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)
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)
Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
debkap=debaykapcat(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
!c!-------------------------------------------------------------------
(( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
!c! epol = 0.0d0
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
- / ( 2.0d0 * fgb1 )
+ / ( 2.0d0 * fgb1 )
dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
- / ( 2.0d0 * fgb2 )
+ / ( 2.0d0 * fgb2 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
- * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
- * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
+ * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
dPOLdR1 = dPOLdFGB1 * dFGBdR1
!c! dPOLdR1 = 0.0d0
dPOLdR2 = dPOLdFGB2 * dFGBdR2
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
!c!-------------------------------------------------------------------
!c! Return the results
!c! These things do the dRdX derivatives, that is
!c! distance to function that changes with LOCATION (of the interaction
!c! site)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
!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
al3 = alphiso(3,itypi,itypj)
al4 = alphiso(4,itypi,itypj)
csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0&
- + sigiso2(itypi,itypj)**2.0d0))
+ + sigiso2(itypi,itypj)**2.0d0))
!c!
w1 = wqdip(1,itypi,itypj)
w2 = wqdip(2,itypi,itypj)
!c! First things first:
!c! We need to do sc_grad's job with GB and Fcav
eom1 = eps2der * eps2rt_om1 &
- - 2.0D0 * alf1 * eps3der&
- + sigder * sigsq_om1&
- + dCAVdOM1
+ - 2.0D0 * alf1 * eps3der&
+ + sigder * sigsq_om1&
+ + dCAVdOM1
eom2 = eps2der * eps2rt_om2 &
- + 2.0D0 * alf2 * eps3der&
- + sigder * sigsq_om2&
- + dCAVdOM2
+ + 2.0D0 * alf2 * eps3der&
+ + sigder * sigsq_om2&
+ + dCAVdOM2
eom12 = evdwij * eps1_om12 &
- + eps2der * eps2rt_om12 &
- - 2.0D0 * alf12 * eps3der&
- + sigder *sigsq_om12&
- + dCAVdOM12
+ + eps2der * eps2rt_om12 &
+ - 2.0D0 * alf12 * eps3der&
+ + sigder *sigsq_om12&
+ + dCAVdOM12
!c! now some magical transformations to project gradient into
!c! three cartesian vectors
DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
- gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
!c! this acts on hydrophobic center of interaction
- gvdwx(k,i)= gvdwx(k,i) - gg(k) &
- + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)= gvdwx(k,j) + gg(k) &
- + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
- + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ gvdwx(k,i)= gvdwx(k,i) - gg(k) &
+ + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ gvdwx(k,j)= gvdwx(k,j) + gg(k) &
+ + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! this acts on Calpha
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
+ gvdwc(k,i)=gvdwc(k,i)-gg(k)
+ gvdwc(k,j)=gvdwc(k,j)+gg(k)
END DO
!c! sc_grad is done, now we will compute
eheadtail = 0.0d0
eom12 = 0.0d0
DO istate = 1, nstate(itypi,itypj)
!c*************************************************************
- IF (istate.ne.1) THEN
- IF (istate.lt.3) THEN
- ii = 1
- ELSE
- ii = 2
- END IF
- jj = istate/ii
- d1 = dhead(1,ii,itypi,itypj)
- d2 = dhead(2,jj,itypi,itypj)
- DO k = 1,3
- chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
- chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
- Rhead_distance(k) = chead(k,2) - chead(k,1)
- END DO
+ IF (istate.ne.1) THEN
+ IF (istate.lt.3) THEN
+ ii = 1
+ ELSE
+ ii = 2
+ END IF
+ jj = istate/ii
+ d1 = dhead(1,ii,itypi,itypj)
+ d2 = dhead(2,jj,itypi,itypj)
+ DO k = 1,3
+ chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
+ chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
+ Rhead_distance(k) = chead(k,2) - chead(k,1)
+ END DO
!c! pitagoras (root of sum of squares)
- Rhead = dsqrt( &
- (Rhead_distance(1)*Rhead_distance(1)) &
- + (Rhead_distance(2)*Rhead_distance(2)) &
- + (Rhead_distance(3)*Rhead_distance(3)))
- END IF
- Rhead_sq = Rhead * Rhead
+ Rhead = dsqrt( &
+ (Rhead_distance(1)*Rhead_distance(1)) &
+ + (Rhead_distance(2)*Rhead_distance(2)) &
+ + (Rhead_distance(3)*Rhead_distance(3)))
+ END IF
+ Rhead_sq = Rhead * Rhead
!c! R1 - distance between head of ith side chain and tail of jth sidechain
!c! R2 - distance between head of jth side chain and tail of ith sidechain
- R1 = 0.0d0
- R2 = 0.0d0
- DO k = 1, 3
+ R1 = 0.0d0
+ R2 = 0.0d0
+ DO k = 1, 3
!c! Calculate head-to-tail distances
- R1=R1+(ctail(k,2)-chead(k,1))**2
- R2=R2+(chead(k,2)-ctail(k,1))**2
- END DO
+ R1=R1+(ctail(k,2)-chead(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
+ END DO
!c! Pitagoras
- R1 = dsqrt(R1)
- R2 = dsqrt(R2)
- Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
+ R1 = dsqrt(R1)
+ R2 = dsqrt(R2)
+ Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
!c! Ecl = 0.0d0
!c! write (*,*) "Ecl = ", Ecl
!c! derivative of Ecl is Gcl...
- dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
+ dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
!c! dGCLdR = 0.0d0
- dGCLdOM1 = 0.0d0
- dGCLdOM2 = 0.0d0
- dGCLdOM12 = 0.0d0
+ dGCLdOM1 = 0.0d0
+ dGCLdOM2 = 0.0d0
+ dGCLdOM12 = 0.0d0
!c!-------------------------------------------------------------------
!c! Generalised Born Solvent Polarization
- ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
- Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
- Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
+ ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
+ Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
+ Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
!c! Egb = 0.0d0
!c! write (*,*) "a1*a2 = ", a12sq
!c! write (*,*) "Rhead = ", Rhead
!c! write (*,*) "Egb = ", Egb
!c! Derivative of Egb is Ggb...
!c! dFGBdR is used by Quad's later...
- dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
- dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
- / ( 2.0d0 * Fgb )
- dGGBdR = dGGBdFGB * dFGBdR
+ dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
+ dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
+ / ( 2.0d0 * Fgb )
+ dGGBdR = dGGBdFGB * dFGBdR
!c! dGGBdR = 0.0d0
!c!-------------------------------------------------------------------
!c! Fisocav - isotropic cavity creation term
- pom = Rhead * csig
- top = al1 * (dsqrt(pom) + al2 * pom - al3)
- bot = (1.0d0 + al4 * pom**12.0d0)
- botsq = bot * bot
- FisoCav = top / bot
- dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
- dbot = 12.0d0 * al4 * pom ** 11.0d0
- dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
+ pom = Rhead * csig
+ top = al1 * (dsqrt(pom) + al2 * pom - al3)
+ bot = (1.0d0 + al4 * pom**12.0d0)
+ botsq = bot * bot
+ FisoCav = top / bot
+ dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
+ dbot = 12.0d0 * al4 * pom ** 11.0d0
+ dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
!c! dGCVdR = 0.0d0
!c!-------------------------------------------------------------------
!c! Polarization energy
!c! Epol
- MomoFac1 = (1.0d0 - chi1 * sqom2)
- MomoFac2 = (1.0d0 - chi2 * sqom1)
- RR1 = ( R1 * R1 ) / MomoFac1
- RR2 = ( R2 * R2 ) / MomoFac2
- ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
- ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
- fgb1 = sqrt( RR1 + a12sq * ee1 )
- fgb2 = sqrt( RR2 + a12sq * ee2 )
- epol = 332.0d0 * eps_inout_fac * (&
- (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
+ MomoFac1 = (1.0d0 - chi1 * sqom2)
+ MomoFac2 = (1.0d0 - chi2 * sqom1)
+ RR1 = ( R1 * R1 ) / MomoFac1
+ RR2 = ( R2 * R2 ) / MomoFac2
+ ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
+ ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
+ fgb1 = sqrt( RR1 + a12sq * ee1 )
+ fgb2 = sqrt( RR2 + a12sq * ee2 )
+ epol = 332.0d0 * eps_inout_fac * (&
+ (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
!c! epol = 0.0d0
!c! derivative of Epol is Gpol...
- dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
- / (fgb1 ** 5.0d0)
- dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
- / (fgb2 ** 5.0d0)
- dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) )&
- / ( 2.0d0 * fgb1 )
- dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / ( 2.0d0 * fgb2 )
- dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * ( 2.0d0 - 0.5d0 * ee1) ) &
- / ( 2.0d0 * fgb1 )
- dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * ( 2.0d0 - 0.5d0 * ee2) ) &
- / ( 2.0d0 * fgb2 )
- dPOLdR1 = dPOLdFGB1 * dFGBdR1
+ dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
+ / (fgb1 ** 5.0d0)
+ dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
+ / (fgb2 ** 5.0d0)
+ dFGBdR1 = ( (R1 / MomoFac1) &
+ * ( 2.0d0 - (0.5d0 * ee1) ) )&
+ / ( 2.0d0 * fgb1 )
+ dFGBdR2 = ( (R2 / MomoFac2) &
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / ( 2.0d0 * fgb2 )
+ dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
+ * ( 2.0d0 - 0.5d0 * ee1) ) &
+ / ( 2.0d0 * fgb1 )
+ dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
+ * ( 2.0d0 - 0.5d0 * ee2) ) &
+ / ( 2.0d0 * fgb2 )
+ dPOLdR1 = dPOLdFGB1 * dFGBdR1
!c! dPOLdR1 = 0.0d0
- dPOLdR2 = dPOLdFGB2 * dFGBdR2
+ dPOLdR2 = dPOLdFGB2 * dFGBdR2
!c! dPOLdR2 = 0.0d0
- dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
+ dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! dPOLdOM1 = 0.0d0
- dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
- pom = (pis / Rhead)**6.0d0
- Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
+ dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
+ pom = (pis / Rhead)**6.0d0
+ Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! Elj = 0.0d0
!c! derivative of Elj is Glj
- dGLJdR = 4.0d0 * eps_head &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ dGLJdR = 4.0d0 * eps_head &
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
!c! dGLJdR = 0.0d0
!c!-------------------------------------------------------------------
!c! Equad
IF (Wqd.ne.0.0d0) THEN
- Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
- - 37.5d0 * ( sqom1 + sqom2 ) &
- + 157.5d0 * ( sqom1 * sqom2 ) &
- - 45.0d0 * om1*om2*om12
- fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
- Equad = fac * Beta1
+ Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
+ - 37.5d0 * ( sqom1 + sqom2 ) &
+ + 157.5d0 * ( sqom1 * sqom2 ) &
+ - 45.0d0 * om1*om2*om12
+ fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
+ Equad = fac * Beta1
!c! Equad = 0.0d0
!c! derivative of Equad...
- dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
+ dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
!c! dQUADdR = 0.0d0
- dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
+ dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
!c! dQUADdOM1 = 0.0d0
- dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
+ dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
!c! dQUADdOM2 = 0.0d0
- dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
+ dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
ELSE
- Beta1 = 0.0d0
- Equad = 0.0d0
- END IF
+ Beta1 = 0.0d0
+ Equad = 0.0d0
+ END IF
!c!-------------------------------------------------------------------
!c! Return the results
!c! Angular stuff
- eom1 = dPOLdOM1 + dQUADdOM1
- eom2 = dPOLdOM2 + dQUADdOM2
- eom12 = dQUADdOM12
+ eom1 = dPOLdOM1 + dQUADdOM1
+ eom2 = dPOLdOM2 + dQUADdOM2
+ eom12 = dQUADdOM12
!c! now some magical transformations to project gradient into
!c! three cartesian vectors
- DO k = 1, 3
- dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
- dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
- tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
- END DO
+ DO k = 1, 3
+ dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
+ dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
+ tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
+ END DO
!c! Radial stuff
- DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
- END DO
- erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
- erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
- bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
- federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
- eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
- adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
- facd1 = d1 * vbld_inv(i+nres)
- facd2 = d2 * vbld_inv(j+nres)
- facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
- facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
- DO k = 1, 3
- hawk = erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
- condor = erhead_tail(k,2) + &
- facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
-
- pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ DO k = 1, 3
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ END DO
+ erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
+ erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
+ bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
+ federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
+ eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
+ adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
+ facd1 = d1 * vbld_inv(i+nres)
+ facd2 = d2 * vbld_inv(j+nres)
+ facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
+ facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
+ DO k = 1, 3
+ hawk = erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
+ condor = erhead_tail(k,2) + &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
!c! this acts on hydrophobic center of interaction
- gheadtail(k,1,1) = gheadtail(k,1,1) &
- - dGCLdR * pom &
- - dGGBdR * pom &
- - dGCVdR * pom &
- - dPOLdR1 * hawk &
- - dPOLdR2 * (erhead_tail(k,2) &
+ gheadtail(k,1,1) = gheadtail(k,1,1) &
+ - dGCLdR * pom &
+ - dGGBdR * pom &
+ - dGCVdR * pom &
+ - dPOLdR1 * hawk &
+ - dPOLdR2 * (erhead_tail(k,2) &
-facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
- - dGLJdR * pom &
- - dQUADdR * pom&
- - tuna(k) &
- + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
- + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+ - dGLJdR * pom &
+ - dQUADdR * pom&
+ - tuna(k) &
+ + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
+ + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
!c! this acts on hydrophobic center of interaction
- gheadtail(k,2,1) = gheadtail(k,2,1) &
- + dGCLdR * pom &
- + dGGBdR * pom &
- + dGCVdR * pom &
- + dPOLdR1 * (erhead_tail(k,1) &
+ gheadtail(k,2,1) = gheadtail(k,2,1) &
+ + dGCLdR * pom &
+ + dGGBdR * pom &
+ + dGCVdR * pom &
+ + dPOLdR1 * (erhead_tail(k,1) &
-facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
- + dPOLdR2 * condor &
- + dGLJdR * pom &
- + dQUADdR * pom &
- + tuna(k) &
- + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
- + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+ + dPOLdR2 * condor &
+ + dGLJdR * pom &
+ + dQUADdR * pom &
+ + tuna(k) &
+ + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
+ + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
!c! this acts on Calpha
- gheadtail(k,3,1) = gheadtail(k,3,1) &
- - dGCLdR * erhead(k)&
- - dGGBdR * erhead(k)&
- - dGCVdR * erhead(k)&
- - dPOLdR1 * erhead_tail(k,1)&
- - dPOLdR2 * erhead_tail(k,2)&
- - dGLJdR * erhead(k) &
- - dQUADdR * erhead(k)&
- - tuna(k)
+ gheadtail(k,3,1) = gheadtail(k,3,1) &
+ - dGCLdR * erhead(k)&
+ - dGGBdR * erhead(k)&
+ - dGCVdR * erhead(k)&
+ - dPOLdR1 * erhead_tail(k,1)&
+ - dPOLdR2 * erhead_tail(k,2)&
+ - dGLJdR * erhead(k) &
+ - dQUADdR * erhead(k)&
+ - tuna(k)
!c! this acts on Calpha
- gheadtail(k,4,1) = gheadtail(k,4,1) &
- + dGCLdR * erhead(k) &
- + dGGBdR * erhead(k) &
- + dGCVdR * erhead(k) &
- + dPOLdR1 * erhead_tail(k,1) &
- + dPOLdR2 * erhead_tail(k,2) &
- + dGLJdR * erhead(k) &
- + dQUADdR * erhead(k)&
- + tuna(k)
- END DO
- ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
- eheadtail = eheadtail &
- + wstate(istate, itypi, itypj) &
- * dexp(-betaT * ener(istate))
+ gheadtail(k,4,1) = gheadtail(k,4,1) &
+ + dGCLdR * erhead(k) &
+ + dGGBdR * erhead(k) &
+ + dGCVdR * erhead(k) &
+ + dPOLdR1 * erhead_tail(k,1) &
+ + dPOLdR2 * erhead_tail(k,2) &
+ + dGLJdR * erhead(k) &
+ + dQUADdR * erhead(k)&
+ + tuna(k)
+ END DO
+ ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
+ eheadtail = eheadtail &
+ + wstate(istate, itypi, itypj) &
+ * dexp(-betaT * ener(istate))
!c! foreach cartesian dimension
- DO k = 1, 3
+ DO k = 1, 3
!c! foreach of two gvdwx and gvdwc
- DO l = 1, 4
- gheadtail(k,l,2) = gheadtail(k,l,2) &
- + wstate( istate, itypi, itypj ) &
- * dexp(-betaT * ener(istate)) &
- * gheadtail(k,l,1)
- gheadtail(k,l,1) = 0.0d0
- END DO
- END DO
+ DO l = 1, 4
+ gheadtail(k,l,2) = gheadtail(k,l,2) &
+ + wstate( istate, itypi, itypj ) &
+ * dexp(-betaT * ener(istate)) &
+ * gheadtail(k,l,1)
+ gheadtail(k,l,1) = 0.0d0
+ END DO
+ END DO
END DO
!c! Here ended the gigantic DO istate = 1, 4, which starts
!c! at the beggining of the subroutine
DO k = 1, 3
- DO l = 1, 4
- gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
- END DO
- gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
- gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
- gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
- gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
- DO l = 1, 4
- gheadtail(k,l,1) = 0.0d0
- gheadtail(k,l,2) = 0.0d0
- END DO
+ DO l = 1, 4
+ gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
+ END DO
+ gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
+ gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
+ gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
+ gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
+ DO l = 1, 4
+ gheadtail(k,l,1) = 0.0d0
+ gheadtail(k,l,2) = 0.0d0
+ END DO
END DO
eheadtail = (-dlog(eheadtail)) / betaT
dPOLdOM1 = 0.0d0
R1 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R1=R1+(ctail(k,2)-chead(k,1))**2
+ R1=R1+(ctail(k,2)-chead(k,1))**2
END DO
!c! Pitagoras
R1 = dsqrt(R1)
fgb1 = sqrt( RR1 + a12sq * ee1)
epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
- / (fgb1 ** 5.0d0)
+ / (fgb1 ** 5.0d0)
dFGBdR1 = ( (R1 / MomoFac1) &
- * ( 2.0d0 - (0.5d0 * ee1) ) ) &
- / ( 2.0d0 * fgb1 )
+ * ( 2.0d0 - (0.5d0 * ee1) ) ) &
+ / ( 2.0d0 * fgb1 )
dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
- * (2.0d0 - 0.5d0 * ee1) ) &
- / (2.0d0 * fgb1)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdR1 = dPOLdFGB1 * dFGBdR1
!c! dPOLdR1 = 0.0d0
dPOLdOM1 = 0.0d0
dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
DO k = 1, 3
- erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
+ erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
END DO
bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
DO k = 1, 3
- hawk = (erhead_tail(k,1) + &
- facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
+ hawk = (erhead_tail(k,1) + &
+ facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
- gvdwx(k,i) = gvdwx(k,i) &
- - dPOLdR1 * hawk
- gvdwx(k,j) = gvdwx(k,j) &
- + dPOLdR1 * (erhead_tail(k,1) &
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dPOLdR1 * hawk
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dPOLdR1 * (erhead_tail(k,1) &
-facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
- gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
- gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
+ gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
+ gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
END DO
RETURN
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R2 = dsqrt(R2)
fgb2 = sqrt(RR2 + a12sq * ee2)
epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / (2.0d0 * fgb2)
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * (2.0d0 - 0.5d0 * ee2) ) &
- / (2.0d0 * fgb2)
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
dPOLdR2 = dPOLdFGB2 * dFGBdR2
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! Return the results
!c! (See comments in Eqq)
DO k = 1, 3
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
facd2 = d2 * vbld_inv(j+nres)
facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
DO k = 1, 3
- condor = (erhead_tail(k,2) &
+ condor = (erhead_tail(k,2) &
+ facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
- gvdwx(k,i) = gvdwx(k,i) &
- - dPOLdR2 * (erhead_tail(k,2) &
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dPOLdR2 * (erhead_tail(k,2) &
-facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
- gvdwx(k,j) = gvdwx(k,j) &
- + dPOLdR2 * condor
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dPOLdR2 * condor
- gvdwc(k,i) = gvdwc(k,i) &
- - dPOLdR2 * erhead_tail(k,2)
- gvdwc(k,j) = gvdwc(k,j) &
- + dPOLdR2 * erhead_tail(k,2)
+ gvdwc(k,i) = gvdwc(k,i) &
+ - dPOLdR2 * erhead_tail(k,2)
+ gvdwc(k,j) = gvdwc(k,j) &
+ + dPOLdR2 * erhead_tail(k,2)
END DO
RETURN
R2 = 0.0d0
DO k = 1, 3
!c! Calculate head-to-tail distances
- R2=R2+(chead(k,2)-ctail(k,1))**2
+ R2=R2+(chead(k,2)-ctail(k,1))**2
END DO
!c! Pitagoras
R2 = dsqrt(R2)
fgb2 = sqrt(RR2 + a12sq * ee2)
epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
- / (fgb2 ** 5.0d0)
+ / (fgb2 ** 5.0d0)
dFGBdR2 = ( (R2 / MomoFac2) &
- * ( 2.0d0 - (0.5d0 * ee2) ) ) &
- / (2.0d0 * fgb2)
+ * ( 2.0d0 - (0.5d0 * ee2) ) ) &
+ / (2.0d0 * fgb2)
dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
- * (2.0d0 - 0.5d0 * ee2) ) &
- / (2.0d0 * fgb2)
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
dPOLdR2 = dPOLdFGB2 * dFGBdR2
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
!c! Return the results
!c! (See comments in Eqq)
DO k = 1, 3
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
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
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
+ - hawk / Rhead**4.0d0
dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ + 4.0d0 * hawk / Rhead**5.0d0
!c! dF/dom1
dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
!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)
+ * (2.0d0 - 0.5d0 * ee1) ) &
+ / (2.0d0 * fgb1)
dPOLdR1 = dPOLdFGB1 * dFGBdR1
!c! dPOLdR1 = 0.0d0
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)))
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)))
+
+ pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
+ gvdwx(k,i) = gvdwx(k,i) &
+ - dGCLdR * pom&
+ - dPOLdR1 * hawk &
+ - dGLJdR * pom
+
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j) &
+ + dGCLdR * pom &
+ + dPOLdR1 * (erhead_tail(k,1) &
-facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
- + dGLJdR * pom
+ + dGLJdR * pom
- 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)
- 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)
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)
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
+ + 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)
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
dPOLdR2 = dPOLdFGB2 * dFGBdR2
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
!c!-------------------------------------------------------------------
!c! Return the results
!c! (see comments in Eqq)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
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) &
+ 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
- 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
- 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)
- 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)
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)
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
+ + 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)
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
dPOLdR2 = dPOLdFGB2 * dFGBdR2
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
!c!-------------------------------------------------------------------
!c! Return the results
!c! (see comments in Eqq)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
erdxj = scalar( erhead(1), dC_norm(1,j) )
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
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)
! print *,"CO2", itypi,itypj
! print *,"CO?!.", w1,w2,Qj,om1
ECL = sparrow / Rhead**2.0d0 &
- - hawk / Rhead**4.0d0
+ - hawk / Rhead**4.0d0
!c!-------------------------------------------------------------------
!c! derivative of ecl is Gcl
!c! dF/dr part
dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
- + 4.0d0 * hawk / Rhead**5.0d0
+ + 4.0d0 * hawk / Rhead**5.0d0
!c! dF/dom1
dGCLdOM1 = (w1 * 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)
+ * (2.0d0 - 0.5d0 * ee2) ) &
+ / (2.0d0 * fgb2)
dPOLdR2 = dPOLdFGB2 * dFGBdR2
!c! dPOLdR2 = 0.0d0
dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
!c! derivative of Elj is Glj
dGLJdR = 4.0d0 * eps_head &
- * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
- + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
+ * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
+ + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
!c!-------------------------------------------------------------------
!c! Return the results
!c! (see comments in Eqq)
DO k = 1, 3
- erhead(k) = Rhead_distance(k)/Rhead
- erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
+ erhead(k) = Rhead_distance(k)/Rhead
+ erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
END DO
erdxi = scalar( erhead(1), dC_norm(1,i) )
erdxj = scalar( erhead(1), dC_norm(1,j) )
facd2 = d2 * vbld_inv(j)
facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+1)/2.0
DO k = 1, 3
- condor = (erhead_tail(k,2) &
+ 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))
+ 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))
+ * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
dGCLdR = c1 - c2
!c! dECL/dom1
c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
+ * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
dGCLdOM1 = c1 - c2
!c! dECL/dom2
c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
- * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
+ * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
dGCLdOM2 = c1 - c2
!c! dECL/dom12
c1 = w1 / (Rhead ** 3.0d0)
!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
+ pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
+ gvdwx(k,j) = gvdwx(k,j) + dGCLdR * pom
- gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k)
- gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k)
+ gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k)
+ gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k)
END DO
RETURN
END SUBROUTINE edd
!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
!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
!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
include 'mpif.h'
real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
real*8 :: dist_init, dist_temp,r_buff_list
- integer:: contlisti(200*nres),contlistj(200*nres)
+ 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)
- 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
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=iabs(itype(j,1))
- if (itypj.eq.ntyp1) cycle
- xj=c(1,nres+j)
- yj=c(2,nres+j)
- zj=c(3,nres+j)
- 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
+ r_buff_list=5.0
+ ilist_sc=0
+ do i=iatsc_s,iatsc_e
+ itypi=iabs(itype(i,1))
+ if (itypi.eq.ntyp1) cycle
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
+ itypj=iabs(itype(j,1))
+ if (itypj.eq.ntyp1) cycle
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ call to_box(xj,yj,zj)
+ 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
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
! Here the list is created
- ilist_sc=ilist_sc+1
+ ilist_sc=ilist_sc+1
! this can be substituted by cantor and anti-cantor
- contlisti(ilist_sc)=i
- contlistj(ilist_sc)=j
+ contlisti(ilist_sc)=i
+ contlistj(ilist_sc)=j
- endif
- enddo
- enddo
- enddo
+ 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,&
#endif
if (nfgtasks.gt.1)then
- call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
- MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+ 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
+ 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)
+ 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(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
+ else
+ g_ilist_sc=ilist_sc
- do i=1,ilist_sc
- newcontlisti(i)=contlisti(i)
- newcontlistj(i)=contlistj(i)
- enddo
- endif
+ do i=1,ilist_sc
+ newcontlisti(i)=contlisti(i)
+ newcontlistj(i)=contlistj(i)
+ enddo
+ endif
#ifdef DEBUG
write (iout,*) "after MPIREDUCE",g_ilist_sc
write (iout,*) i,newcontlisti(i),newcontlistj(i)
enddo
#endif
- call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end)
+ call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end)
return
end subroutine make_SCSC_inter_list
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
include 'mpif.h'
real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
real*8 :: dist_init, dist_temp,r_buff_list
- integer:: contlistscpi(200*nres),contlistscpj(200*nres)
+ integer:: contlistscpi(250*nres),contlistscpj(250*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
+ 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))
- 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)
+ 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
+ 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
! 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
+ 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
+ ! 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
+ 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
+ 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
+ if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then
! Here the list is created
- ilist_scp=ilist_scp+1
+ 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
+ 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
#endif
if (nfgtasks.gt.1)then
- call MPI_Reduce(ilist_scp,g_ilist_scp,1,&
- MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+ 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
+ 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)
+ 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(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
+ else
+ g_ilist_scp=ilist_scp
- do i=1,ilist_scp
- newcontlistscpi(i)=contlistscpi(i)
- newcontlistscpj(i)=contlistscpj(i)
- enddo
- endif
+ do i=1,ilist_scp
+ newcontlistscpi(i)=contlistscpi(i)
+ newcontlistscpj(i)=contlistscpj(i)
+ enddo
+ endif
#ifdef DEBUG
write (iout,*) "after MPIREDUCE",g_ilist_scp
! 126 continue
! enddo
#endif
- call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end)
+ call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end)
return
end subroutine make_SCp_inter_list
subroutine make_pp_inter_list
include 'mpif.h'
real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp
- real*8 :: xmedj,ymedj,zmedj
+ real*8 :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj
real*8 :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi
real*8 :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj
- integer:: contlistppi(200*nres),contlistppj(200*nres)
+ 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
-! print *,"START make_SC"
+ 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
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(i),ielend(i)
+
+ 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
+! 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)
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
-
- 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
- endif
- enddo
- enddo
- enddo
-
+ 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
contlistppi(ilist_pp)=i
contlistppj(ilist_pp)=j
endif
+! enddo
enddo
enddo
-! enddo
#ifdef DEBUG
write (iout,*) "before MPIREDUCE",ilist_pp
do i=1,ilist_pp
projects / unres4.git / commitdiff