subroutine cartgrad implicit real*8 (a-h,o-z) include 'DIMENSIONS' include "DIMENSIONS.ZSCOPT" #ifdef MPI include 'mpif.h' #endif include 'COMMON.CHAIN' include 'COMMON.DERIV' include 'COMMON.VAR' include 'COMMON.INTERACT' include 'COMMON.FFIELD' include 'COMMON.MD' include 'COMMON.IOUNITS' include 'COMMON.TIME1' include "COMMON.NAMES" include "COMMON.ENERGIES" c c This subrouting calculates total Cartesian coordinate gradient. c The subroutine chainbuild_cart and energy MUST be called beforehand. #ifdef TIMING time00=MPI_Wtime() #endif icg=1 #ifdef DEBUG write (iout,*) "gradc, gradx, gloc before sum_gradient" do i=1,nres-1 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gradc(j,i,icg),j=1,3), & (gradx(j,i,icg),j=1,3),gloc(i,icg) enddo write (iout,*) "ghpbc ghpbx" do i=1,nres-1 write (iout,'(i5,2(3f10.5,5x))') i,(ghpbc(j,i),j=1,3), & (ghpbx(j,i),j=1,3) enddo #endif call sum_gradient call sum_gradient_compon #ifdef DEBUG write (iout,*) "gradc, gradx, gloc after sum_gradient" do i=1,nres-1 write (iout,'(i5,2(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 c If performing constraint dynamics, add the gradients of the constraint energy #ifdef TIMING time01=MPI_Wtime() #endif call intcartderiv #ifdef TIMING time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01 #endif cd call checkintcartgrad cd write(iout,*) 'calling int_to_cart' #ifdef DEBUG write (iout,*) "gcart, gxcart, gloc before int_to_cart" #endif do i=1,nct do j=1,3 gcart(j,i)=gradc(j,i,icg) gxcart(j,i)=gradx(j,i,icg) enddo #ifdef DEBUG write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3), & (gxcart(j,i),j=1,3),gloc(i,icg) #endif enddo #ifdef TIMING time01=MPI_Wtime() #endif call int_to_cart #ifdef TIMING time_inttocart=time_inttocart+MPI_Wtime()-time01 #endif #ifdef DEBUG write (iout,*) "gcart and gxcart after int_to_cart" do i=0,nres write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), & (gxcart(j,i),j=1,3) enddo write (iout,*) "Energy components after int_to_cart" 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 CARGRAD #ifdef DEBUG write (iout,*) "CARGRAD" #endif do i=nres,1,-1 do j=1,3 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i) do k=1,n_ene gcompon(k,j,i)=-gcompon(k,j,i)+gcompon(k,j,i-1) & -gcomponx(k,j,i) enddo ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i) enddo ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), & ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3) enddo ! Correction: dummy residues 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) do k=1,n_ene gcompon(k,j,nnt)=gcompon(k,j,nnt)+gcompon(k,j,1) enddo 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) do k=1,n_ene gcompon(k,j,nct)=gcompon(k,j,nct)+gcompon(k,j,nres) enddo enddo endif #ifdef DEBUG write (iout,*) "gcart and gxcart after trasformation" do i=0,nres write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), & (gxcart(j,i),j=1,3) enddo write (iout,*) "Gradient components after transformation" 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 #endif #ifdef TIMING time_cartgrad=time_cartgrad+MPI_Wtime()-time00 #endif return end C------------------------------------------------------------------------- subroutine zerograd implicit real*8 (a-h,o-z) include 'DIMENSIONS' include "DIMENSIONS.ZSCOPT" include 'COMMON.DERIV' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.MD' include 'COMMON.SCCOR' C C Initialize Cartesian-coordinate gradient C 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 gliptranc(j,i)=0.0d0 gshieldc(j,i)=0.0d0 gshieldc_ec(j,i)=0.0d0 gshieldc_t3(j,i)=0.0d0 gshieldc_t4(j,i)=0.0d0 gshieldc_ll(j,i)=0.0d0 gradafm(j,i)=0.0d0 gg_tube_sc(j,i)=0.0d0 gg_tube(j,i)=0.0d0 do intertyp=1,3 gloc_sc(intertyp,i,icg)=0.0d0 enddo enddo enddo C C Initialize the gradient of local energy terms. C 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 c initialize gcart and gxcart do i=0,nres do j=1,3 gcart(j,i)=0.0d0 gxcart(j,i)=0.0d0 enddo enddo return end