subroutine sum_gradient implicit none include 'DIMENSIONS' include "DIMENSIONS.ZSCOPT" #ifndef ISNAN external proc_proc #ifdef WINPGI cMS$ATTRIBUTES C :: proc_proc #endif #endif #ifdef MPI include 'mpif.h' include "COMMON.SETUP" integer ierr,ierror #endif double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres), & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres) & ,gloc_scbuf(3,-1:maxres) include 'COMMON.IOUNITS' include 'COMMON.FFIELD' include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.CONTROL' include 'COMMON.TIME1' include 'COMMON.SCCOR' integer i,j,k double precision time00,time_barrier,time_barrier_g,time_reduce #ifdef TIMING time01=MPI_Wtime() #endif #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) enddo call flush(iout) #endif #ifdef MPI C FG slaves call the following matching MPI_Bcast in ERGASTULUM if (nfgtasks.gt.1 .and. fg_rank.eq.0) & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR) #endif C C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient C in virtual-bond-vector coordinates C #ifdef DEBUG c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc" c do i=1,nres-1 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)') c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i) c enddo c write (iout,*) "gel_loc_tur3 gel_loc_turn4" c do i=1,nres-1 c write (iout,'(i5,3f10.5,2x,f10.5)') c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i) c enddo write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc" do i=1,nres write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3), & g_corr5_loc(i) enddo call flush(iout) #endif #ifdef SPLITELE do i=0,nct do j=1,3 gradbufc(j,i)=wsc*gvdwc(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) & +wliptran*gliptranc(j,i) c & +gradafm(j,i) & +welec*gshieldc(j,i) & +wcorr*gshieldc_ec(j,i) & +wturn3*gshieldc_t3(j,i) & +wturn4*gshieldc_t4(j,i) & +wel_loc*gshieldc_ll(j,i) c & +wtube*gg_tube(j,i) enddo enddo #else do i=0,nct do j=1,3 gradbufc(j,i)=wsc*gvdwc(j,i)+ & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ & welec*gelc_long(j,i)+ & wbond*gradb(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) & +wliptran*gliptranc(j,i) c & +gradafm(j,i) & +welec*gshieldc(j,i) & +wcorr*gshieldc_ec(j,i) & +wturn4*gshieldc_t4(j,i) & +wel_loc*gshieldc_ll(j,i) c & +wtube*gg_tube(j,i) enddo enddo #endif #ifdef MPI if (nfgtasks.gt.1) then time00=MPI_Wtime() #ifdef DEBUG write (iout,*) "gradbufc before allreduce" do i=1,nres write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) enddo call flush(iout) #endif do i=0,nres 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 do i=nnt,nres do k=1,3 gradbufc(k,i)=0.0d0 enddo enddo #ifdef DEBUG write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end write (iout,*) (i," jgrad_start",jgrad_start(i), & " 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 do i=nres-2,-1,-1 do j=1,3 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) enddo enddo #ifdef DEBUG write (iout,*) "gradbufc after summing" do i=1,nres write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) enddo call flush(iout) #endif else #endif #ifdef DEBUG write (iout,*) "gradbufc" do i=1,nres write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) enddo call flush(iout) #endif do i=-1,nres do j=1,3 gradbufc_sum(j,i)=gradbufc(j,i) gradbufc(j,i)=0.0d0 enddo enddo do j=1,3 gradbufc(j,nres-1)=gradbufc_sum(j,nres) enddo do i=nres-2,-1,-1 do j=1,3 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 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) enddo call flush(iout) #endif #ifdef MPI endif #endif do k=1,3 gradbufc(k,nres)=0.0d0 enddo do i=-1,nct do j=1,3 #ifdef SPLITELE C print *,gradbufc(1,13) C print *,welec*gelc(1,13) C print *,wel_loc*gel_loc(1,13) C print *,0.5d0*(wscp*gvdwc_scpp(1,13)) C print *,welec*gelc_long(1,13)+wvdwpp*gvdwpp(1,13) C print *,wel_loc*gel_loc_long(1,13) C print *,gradafm(1,13),"AFM" 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)+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))+ & wbond*gradb(j,i)+ & wcorr*gradcorr(j,i)+ & wturn3*gcorr3_turn(j,i)+ & wturn4*gcorr4_turn(j,i)+ & wcorr5*gradcorr5(j,i)+ & wcorr6*gradcorr6(j,i)+ & wturn6*gcorr6_turn(j,i)+ & wsccor*gsccorc(j,i) & +wscloc*gscloc(j,i) & +wliptran*gliptranc(j,i) c & +gradafm(j,i) & +welec*gshieldc(j,i) & +welec*gshieldc_loc(j,i) & +wcorr*gshieldc_ec(j,i) & +wcorr*gshieldc_loc_ec(j,i) & +wturn3*gshieldc_t3(j,i) & +wturn3*gshieldc_loc_t3(j,i) & +wturn4*gshieldc_t4(j,i) & +wturn4*gshieldc_loc_t4(j,i) & +wel_loc*gshieldc_ll(j,i) & +wel_loc*gshieldc_loc_ll(j,i) c & +wtube*gg_tube(j,i) #else 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)+ & wel_loc*gel_loc_long(j,i)+ & wcorr*gcorr_long(j,i)+ & wcorr5*gradcorr5_long(j,i)+ & wcorr6*gradcorr6_long(j,i)+ & wturn6*gcorr6_turn_long(j,i))+ & wbond*gradb(j,i)+ & wcorr*gradcorr(j,i)+ & wturn3*gcorr3_turn(j,i)+ & wturn4*gcorr4_turn(j,i)+ & wcorr5*gradcorr5(j,i)+ & wcorr6*gradcorr6(j,i)+ & wturn6*gcorr6_turn(j,i)+ & wsccor*gsccorc(j,i) & +wscloc*gscloc(j,i) & +wliptran*gliptranc(j,i) c & +gradafm(j,i) & +welec*gshieldc(j,i) & +welec*gshieldc_loc(j,i) & +wcorr*gshieldc_ec(j,i) & +wcorr*gshieldc_loc_ec(j,i) & +wturn3*gshieldc_t3(j,i) & +wturn3*gshieldc_loc_t3(j,i) & +wturn4*gshieldc_t4(j,i) & +wturn4*gshieldc_loc_t4(j,i) & +wel_loc*gshieldc_ll(j,i) & +wel_loc*gshieldc_loc_ll(j,i) c & +wtube*gg_tube(j,i) #endif 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) & +wliptran*gliptranx(j,i) & +welec*gshieldx(j,i) & +wcorr*gshieldx_ec(j,i) & +wturn3*gshieldx_t3(j,i) & +wturn4*gshieldx_t4(j,i) & +wel_loc*gshieldx_ll(j,i) c & +wtube*gg_tube_sc(j,i) enddo enddo #ifdef DEBUG write (iout,*) "gloc before adding corr" do i=1,4*nres write (iout,*) i,gloc(i,icg) enddo #endif do i=1,nres-3 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) & +wcorr5*g_corr5_loc(i) & +wcorr6*g_corr6_loc(i) & +wturn4*gel_loc_turn4(i) & +wturn3*gel_loc_turn3(i) & +wturn6*gel_loc_turn6(i) & +wel_loc*gel_loc_loc(i) enddo #ifdef DEBUG write (iout,*) "gloc after adding corr" do i=1,4*nres write (iout,*) i,gloc(i,icg) enddo #endif #ifdef MPI if (nfgtasks.gt.1) then do j=1,3 do i=1,nres gradbufc(j,i)=gradc(j,i,icg) gradbufx(j,i)=gradx(j,i,icg) enddo enddo do i=1,4*nres glocbuf(i)=gloc(i,icg) enddo c#define DEBUG #ifdef DEBUG write (iout,*) "gloc_sc before reduce" do i=1,nres do j=1,1 write (iout,*) i,j,gloc_sc(j,i,icg) enddo enddo #endif c#undef DEBUG do i=1,nres do j=1,3 gloc_scbuf(j,i)=gloc_sc(j,i,icg) enddo enddo time00=MPI_Wtime() c write (iout,*) "GRAD: MPI_BARRIER" c call flush(iout) call MPI_Barrier(FG_COMM,IERR) time_barrier_g=time_barrier_g+MPI_Wtime()-time00 time00=MPI_Wtime() call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres, & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres, & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) time_reduce=time_reduce+MPI_Wtime()-time00 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres, & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) time_reduce=time_reduce+MPI_Wtime()-time00 c#define DEBUG #ifdef DEBUG write (iout,*) "gloc_sc after reduce" do i=1,nres do j=1,1 write (iout,*) i,j,gloc_sc(j,i,icg) enddo enddo #endif c#undef DEBUG #ifdef DEBUG write (iout,*) "gloc after reduce" do i=1,4*nres write (iout,*) i,gloc(i,icg) enddo #endif endif #endif #ifdef DEBUG write (iout,*) "gradc gradx gloc" do i=1,nres write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) enddo #endif #ifdef TIMING time_sumgradient=time_sumgradient+MPI_Wtime()-time01 #endif return end c--------------------------------------------------------------------------- subroutine sum_gradient_compon implicit none include 'DIMENSIONS' include "DIMENSIONS.ZSCOPT" #ifndef ISNAN external proc_proc #ifdef WINPGI cMS$ATTRIBUTES C :: proc_proc #endif #endif #ifdef MPI include 'mpif.h' include "COMMON.SETUP" integer ierr,ierror #endif double precision gradbufc(3,-1:maxres),gradbufc_sum(3,-1:maxres), & glocbuf(max_ene,4*maxres) include 'COMMON.IOUNITS' include 'COMMON.FFIELD' include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.CONTROL' include 'COMMON.TIME1' include 'COMMON.SCCOR' include "COMMON.NAMES" include "COMMON.ENERGIES" integer i,j,k,ii,iene double precision time_reduce,time00 #ifdef TIMING time01=MPI_Wtime() #endif C Sum up the components of the Cartesian gradient. C gcompon=0.0d0 gcompon_loc=0.0d0 gcomponx=0.0d0 do i=1,nct do j=1,3 c Part in coordinates gcompon(1,j,i)=gvdwc(j,i) gcompon(2,j,i)=gvdwc_scp(j,i)+gvdwc_scpp(j,i) gcompon(3,j,i)=gelc_long(j,i) gcompon(16,j,i)=gvdwpp(j,i) gcompon(7,j,i)=gel_loc_long(j,i) gcompon(4,j,i)=gradcorr_long(j,i) gcompon(5,j,i)=gradcorr5_long(j,i) gcompon(6,j,i)=gradcorr6_long(j,i) gcompon(10,j,i)=gcorr6_turn_long(j,i) gcompon(15,j,i)=ghpbc(j,i) gcompon(22,j,i)=gliptranc(j,i) c Part in vectors gcompon_loc(2,j,i)=0.5d0*gvdwc_scpp(j,i) gcompon_loc(3,j,i)=0.5d0*gelc_long(j,i)+gelc(j,i) gcompon_loc(16,j,i)=0.5d0*gvdwpp(j,i) gcompon_loc(4,j,i)=0.5d0*gradcorr_long(j,i)+gradcorr(j,i) gcompon_loc(5,j,i)=0.5d0*gradcorr5_long(j,i)+gradcorr5(j,i) gcompon_loc(6,j,i)=0.5d0*gradcorr6_long(j,i)+gradcorr6(j,i) gcompon_loc(7,j,i)=0.5d0*gel_loc_long(j,i)+gel_loc(j,i) gcompon_loc(8,j,i)=gcorr3_turn(j,i) gcompon_loc(9,j,i)=gcorr4_turn(j,i) gcompon_loc(10,j,i)=0.5d0*gcorr6_turn_long(j,i) & +gcorr6_turn(j,i) gcompon_loc(12,j,i)=gscloc(j,i) gcompon_loc(17,j,i)=gradb(j,i) gcompon_loc(19,j,i)=gsccorc(j,i) gcompon_loc(22,j,i)=gliptranc(j,i) c sidechain components gcomponx(1,j,i)=gvdwx(j,i) gcomponx(2,j,i)=gradx_scp(j,i) gcomponx(12,j,i)=gsclocx(j,i) gcomponx(17,j,i)=gradbx(j,i) gcomponx(19,j,i)=gsccorx(j,i) gcomponx(22,j,i)=gliptranx(j,i) if (shield_mode.gt.0) then c Part in coordinates gcompon(3,j,i)=gcompon(3,j,i)+gshieldc(j,i) gcompon(4,j,i)=gcompon(4,j,i)+gshieldc_ec(j,i) gcompon(7,j,i)=gcompon(7,j,i)+gshieldc_ll(j,i) gcompon(8,j,i)=gcompon(8,j,i)+gshieldc_t3(j,i) gcompon(9,j,i)=gcompon(9,j,i)+gshieldc_t4(j,i) c part in vectors gcompon_loc(3,j,i)=gshieldc(j,i)+gshieldc_loc(j,i) gcompon_loc(4,j,i)=gcompon_loc(4,j,i)+gshieldc_ec(j,i) & +gshieldc_loc_ec(j,i) gcompon_loc(7,j,i)=gcompon_loc(7,j,i)+gshieldc_ll(j,i) & +gshieldc_loc_ll(j,i) gcompon_loc(8,j,i)=gcompon_loc(8,j,i)+gshieldc_t3(j,i) & +gshieldc_loc_t3(j,i) gcompon_loc(9,j,i)=gcompon_loc(9,j,i)+gshieldc_t4(j,i) & +gshieldc_loc_t4(j,i) c Part in sidechains gcomponx(3,j,i)=gshieldx(j,i) gcomponx(4,j,i)=gshieldx_ec(j,i) gcomponx(7,j,i)=gshieldx_ec(j,i) gcomponx(8,j,i)=gshieldx_t3(j,i) gcomponx(9,j,i)=gshieldx_t4(j,i) endif #ifndef SPLITELE gcompon(3,j,i)=gcompon(3,j,i)+gcompon(16,j,i) gcompon_loc(3,j,i)=gcompon_loc(3,j,i)+gcompon_loc(16,j,i) #endif enddo enddo do i=1,nres-3 c gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) c & +wcorr5*g_corr5_loc(i) c & +wcorr6*g_corr6_loc(i) c & +wturn4*gel_loc_turn4(i) c & +wturn3*gel_loc_turn3(i) c & +wturn6*gel_loc_turn6(i) c & +wel_loc*gel_loc_loc(i) gloc_compon(4,i)=gcorr_loc(i) gloc_compon(5,i)=g_corr5_loc(i) gloc_compon(6,i)=g_corr6_loc(i) gloc_compon(7,i)=gel_loc_loc(i) gloc_compon(8,i)=gel_loc_turn3(i) gloc_compon(9,i)=gel_loc_turn4(i) gloc_compon(10,i)=gel_loc_turn6(i) c & +wsccor*gsccor_loc(i) c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA enddo #ifdef DEBUG write (iout,*) "Gradient components right after assignment" do iene=1,n_ene write (iout,'(a,i3,1x,a)') "Component",iene,ename(iene) do i=1,nres write (iout,'(a4,i5,3e15.5,5x,e15.5,5x,3e15.5,5x,e15.5)') & restyp(itype(i)),i,(gcompon(iene,j,i),j=1,3), & gloc_compon(iene,i),(gcomponx(iene,j,i),j=1,3), & gloc_compon(iene,nres+i) enddo enddo #endif #ifdef MPI C FG slaves call the following matching MPI_Bcast in ERGASTULUM if (nfgtasks.gt.1 .and. fg_rank.eq.0) & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR) #endif do iene=1,n_ene gradbufc = 0.0d0 gradbufc_sum=0.0d0 do i=0,nct do j=1,3 gradbufc_sum(j,i)=gcompon(iene,j,i) enddo enddo do j=1,3 gradbufc(j,nres-1)=gradbufc_sum(j,nres) enddo do i=nres-2,-1,-1 do j=1,3 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) enddo enddo #ifdef DEBUG write (iout,*) "gradbufc after summing" do i=1,nres write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) enddo call flush(iout) #endif do k=1,3 gradbufc(k,nres)=0.0d0 enddo do i=-1,nct do j=1,3 gcompon(iene,j,i)=gradbufc(j,i)+gcompon_loc(iene,j,i) enddo enddo enddo ! iprot #ifdef MPI if (nfgtasks.gt.1) then gcompon_loc = gcompon time00=MPI_Wtime() call MPI_Reduce(gcompon_loc(1,1,1),gcompon(1,1,1), & 3*nres*max_ene, & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) gcompon_loc = gcomponx call MPI_Reduce(gcompon_loc(1,1,1),gcomponx(1,1,1), & 3*nres*max_ene, & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) glocbuf = gloc_compon call MPI_Reduce(glocbuf(1,1),gloc_compon(1,1),4*nres*max_ene, & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) time_reduce=time_reduce+MPI_Wtime()-time00 endif c#define DEBUG #endif #ifdef DEBUG write (iout,*) "Gradient components in sum_gradient_compon" do iene=1,n_ene write (iout,'(a,i3,1x,a)') "Component",iene,ename(iene) do i=1,nres write (iout,'(a4,i5,3e15.5,5x,e15.5,5x,3e15.5,5x,e15.5)') & restyp(itype(i)),i,(gcompon(iene,j,i),j=1,3), & gloc_compon(iene,i),(gcomponx(iene,j,i),j=1,3), & gloc_compon(iene,nres+i) enddo enddo #endif #ifdef TIMING time_sumgradient=time_sumgradient+MPI_Wtime()-time01 #endif return end