X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc_MD%2Fenergy_p_new_barrier.F;h=3feefaa6e6dff9979cc52a2906320d40b41a410c;hb=ff9a071079186f457da04ffcc64bf115f91a9465;hp=51fbd11688a474e0816b150a8b700403533ed3c2;hpb=a45ce81aae2c857c30b821e39e45a7a08356de4d;p=unres.git diff --git a/source/unres/src_MD/energy_p_new_barrier.F b/source/unres/src_MD/energy_p_new_barrier.F index 51fbd11..3feefaa 100644 --- a/source/unres/src_MD/energy_p_new_barrier.F +++ b/source/unres/src_MD/energy_p_new_barrier.F @@ -493,8 +493,9 @@ cMS$ATTRIBUTES C :: proc_proc #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 @@ -527,6 +528,21 @@ c enddo 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)+ @@ -540,6 +556,7 @@ c enddo & wstrain*ghpbc(j,i) enddo enddo +#endif #else do i=1,nct do j=1,3 @@ -571,6 +588,16 @@ c enddo 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 @@ -585,6 +612,17 @@ c time_allreduce=time_allreduce+MPI_Wtime()-time00 & " 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 @@ -623,6 +661,16 @@ c time_allreduce=time_allreduce+MPI_Wtime()-time00 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 @@ -661,7 +709,7 @@ c time_allreduce=time_allreduce+MPI_Wtime()-time00 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)+ @@ -677,11 +725,20 @@ c time_allreduce=time_allreduce+MPI_Wtime()-time00 & 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 @@ -764,6 +821,10 @@ c 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 @@ -802,6 +863,10 @@ c 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 @@ -973,7 +1038,7 @@ C------------------------------------------------------------------------ & '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)'/ @@ -4174,49 +4239,90 @@ C iii and jjj point to the residues for which the distance is assigned. 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