#ifdef DEBUG
write (iout,*) "sum_gradient gvdwc, gvdwx"
do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
- & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
+ write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
+ & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
+ & (gvdwcT(j,i),j=1,3)
enddo
call flush(iout)
#endif
call flush(iout)
#endif
#ifdef SPLITELE
+#ifdef TSCSC
+ do i=1,nct
+ do j=1,3
+ gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
+ & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
+ & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
+ & wel_loc*gel_loc_long(j,i)+
+ & wcorr*gradcorr_long(j,i)+
+ & wcorr5*gradcorr5_long(j,i)+
+ & wcorr6*gradcorr6_long(j,i)+
+ & wturn6*gcorr6_turn_long(j,i)+
+ & wstrain*ghpbc(j,i)
+ enddo
+ enddo
+#else
do i=1,nct
do j=1,3
gradbufc(j,i)=wsc*gvdwc(j,i)+
& wstrain*ghpbc(j,i)
enddo
enddo
+#endif
#else
do i=1,nct
do j=1,3
gradbufc_sum(j,i)=gradbufc(j,i)
enddo
enddo
+c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
+c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
+c time_reduce=time_reduce+MPI_Wtime()-time00
+#ifdef DEBUG
+c write (iout,*) "gradbufc_sum after allreduce"
+c do i=1,nres
+c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
+c enddo
+c call flush(iout)
+#endif
#ifdef TIMING
c time_allreduce=time_allreduce+MPI_Wtime()-time00
#endif
& " jgrad_end ",jgrad_end(i),
& i=igrad_start,igrad_end)
#endif
+c
+c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
+c do not parallelize this part.
+c
+c do i=igrad_start,igrad_end
+c do j=jgrad_start(i),jgrad_end(i)
+c do k=1,3
+c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
+c enddo
+c enddo
+c enddo
do j=1,3
gradbufc(j,nres-1)=gradbufc_sum(j,nres)
enddo
gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
enddo
enddo
+c do i=nnt,nres-1
+c do k=1,3
+c gradbufc(k,i)=0.0d0
+c enddo
+c do j=i+1,nres
+c do k=1,3
+c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
+c enddo
+c enddo
+c enddo
#ifdef DEBUG
write (iout,*) "gradbufc after summing"
do i=1,nres
gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
& wel_loc*gel_loc(j,i)+
& 0.5d0*(wscp*gvdwc_scpp(j,i)+
- & welec*gelc_long(j,i)
+ & welec*gelc_long(j,i)+
& wel_loc*gel_loc_long(j,i)+
& wcorr*gcorr_long(j,i)+
& wcorr5*gradcorr5_long(j,i)+
& wsccor*gsccorc(j,i)
& +wscloc*gscloc(j,i)
#endif
+#ifdef TSCSC
+ gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
+ & wscp*gradx_scp(j,i)+
+ & wbond*gradbx(j,i)+
+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
+ & wsccor*gsccorx(j,i)
+ & +wscloc*gsclocx(j,i)
+#else
gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
& wbond*gradbx(j,i)+
& wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
& wsccor*gsccorx(j,i)
& +wscloc*gsclocx(j,i)
+#endif
enddo
enddo
#ifdef DEBUG
do i=1,nct
gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
+#ifdef TSCSC
+ gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
+ if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
+#endif
gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
if (gvdwc_scp_norm.gt.gvdwc_scp_max)
& gvdwc_scp_max=gvdwc_scp_norm
if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
+#ifdef TSCSC
+ gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
+ if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
+#endif
gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
if (gradx_scp_norm.gt.gradx_scp_max)
& gradx_scp_max=gradx_scp_norm
& 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
& 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
& 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
- & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
+ & 'EHPB= ',1pE16.6,' WEIGHT=',1pD16.6,
& ' (SS bridges & dist. cnstr.)'/
& 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
& 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
iii=ii
jjj=jj
endif
-cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
+c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
+c & dhpb(i),dhpb1(i),forcon(i)
C 24/11/03 AL: SS bridges handled separately because of introducing a specific
C distance and angle dependent SS bond potential.
if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
call ssbond_ene(iii,jjj,eij)
ehpb=ehpb+2*eij
cd write (iout,*) "eij",eij
+ else if (ii.gt.nres .and. jj.gt.nres) then
+c Restraints from contact prediction
+ dd=dist(ii,jj)
+ if (dhpb1(i).gt.0.0d0) then
+ ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
+c write (iout,*) "beta nmr",
+c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ else
+ dd=dist(ii,jj)
+ rdis=dd-dhpb(i)
+C Get the force constant corresponding to this distance.
+ waga=forcon(i)
+C Calculate the contribution to energy.
+ ehpb=ehpb+waga*rdis*rdis
+c write (iout,*) "beta reg",dd,waga*rdis*rdis
+C
+C Evaluate gradient.
+C
+ fac=waga*rdis/dd
+ endif
+ do j=1,3
+ ggg(j)=fac*(c(j,jj)-c(j,ii))
+ enddo
+ do j=1,3
+ ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
+ ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
+ enddo
+ do k=1,3
+ ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
+ ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
+ enddo
else
C Calculate the distance between the two points and its difference from the
C target distance.
- dd=dist(ii,jj)
- rdis=dd-dhpb(i)
+ dd=dist(ii,jj)
+ if (dhpb1(i).gt.0.0d0) then
+ ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
+c write (iout,*) "alph nmr",
+c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ else
+ rdis=dd-dhpb(i)
C Get the force constant corresponding to this distance.
- waga=forcon(i)
+ waga=forcon(i)
C Calculate the contribution to energy.
- ehpb=ehpb+waga*rdis*rdis
+ ehpb=ehpb+waga*rdis*rdis
+c write (iout,*) "alpha reg",dd,waga*rdis*rdis
C
C Evaluate gradient.
C
- fac=waga*rdis/dd
+ fac=waga*rdis/dd
+ endif
cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
cd & ' waga=',waga,' fac=',fac
- do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
- enddo
+ do j=1,3
+ ggg(j)=fac*(c(j,jj)-c(j,ii))
+ enddo
cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
C If this is a SC-SC distance, we need to calculate the contributions to the
C Cartesian gradient in the SC vectors (ghpbx).
- if (iii.lt.ii) then
+ if (iii.lt.ii) then
do j=1,3
ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
enddo
- endif
+ endif
cgrad do j=iii,jjj-1
cgrad do k=1,3
cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
cgrad enddo
cgrad enddo
- do k=1,3
- ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
- ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
- enddo
+ do k=1,3
+ ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
+ ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
+ enddo
endif
enddo
ehpb=0.5D0*ehpb
projects / unres.git / blobdiff