1 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
4 include 'COMMON.CONTROL'
8 include 'COMMON.INTERACT'
9 include 'COMMON.FFIELD'
11 include 'COMMON.QRESTR'
12 include 'COMMON.IOUNITS'
14 double precision ufparm
17 double precision urparm(1)
18 double precision x(n),g(n)
19 integer i,j,k,ind,ind1
20 double precision f,gthetai,gphii,galphai,gomegai
22 c This subroutine calculates total internal coordinate gradient.
23 c Depending on the number of function evaluations, either whole energy
24 c is evaluated beforehand, Cartesian coordinates and their derivatives in
25 c internal coordinates are reevaluated or only the cartesian-in-internal
26 c coordinate derivatives are evaluated. The subroutine was designed to work
32 cd print *,'grad',nf,icg
33 if (nf-nfl+1) 20,30,40
34 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
35 c write (iout,*) 'grad 20'
38 30 call var_to_geom(n,x)
40 c write (iout,*) 'grad 30'
42 C Transform the gradient to the gradient in angles.
44 40 call cart2intgrad(n,g)
46 C Add the components corresponding to local energy terms.
49 c Add the usampl contributions
52 gloc(i,icg)=gloc(i,icg)+dugamma(i)
55 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
59 cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
62 C Uncomment following three lines for diagnostics.
64 cd call briefout(0,0.0d0)
65 cd write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
68 C-------------------------------------------------------------------------
69 subroutine grad_restr(n,x,nf,g,uiparm,urparm,ufparm)
72 include 'COMMON.CHAIN'
73 include 'COMMON.DERIV'
75 include 'COMMON.INTERACT'
76 include 'COMMON.FFIELD'
77 include 'COMMON.IOUNITS'
79 double precision ufparm
82 double precision urparm(1)
83 double precision x(maxvar),g(maxvar)
84 integer i,j,k,ig,ind,ij,igall
85 double precision f,gthetai,gphii,galphai,gomegai
88 if (nf-nfl+1) 20,30,40
89 20 call func_restr(n,x,nf,f,uiparm,urparm,ufparm)
90 c write (iout,*) 'grad 20'
95 c Intercept NaNs in the coordinates
96 c write(iout,*) (var(i),i=1,nvar)
101 if (x_sum.ne.x_sum) then
102 write(iout,*)" *** grad_restr : Found NaN in coordinates"
104 print *," *** grad_restr : Found NaN in coordinates"
108 call var_to_geom_restr(n,x)
111 C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
115 C Convert the Cartesian gradient into internal-coordinate gradient.
121 IF (mask_phi(i+2).eq.1) THEN
126 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
127 gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
140 IF (mask_theta(i+2).eq.1) THEN
146 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
147 gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
157 if (itype(i).ne.10) then
158 IF (mask_side(i).eq.1) THEN
162 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
171 if (itype(i).ne.10) then
172 IF (mask_side(i).eq.1) THEN
176 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
184 C Add the components corresponding to local energy terms.
191 if (mask_phi(i).eq.1) then
193 g(ig)=g(ig)+gloc(igall,icg)
199 if (mask_theta(i).eq.1) then
201 g(ig)=g(ig)+gloc(igall,icg)
207 if (itype(i).ne.10) then
209 if (mask_side(i).eq.1) then
211 g(ig)=g(ig)+gloc(igall,icg)
218 cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
222 C-------------------------------------------------------------------------
229 include 'COMMON.CONTROL'
230 include 'COMMON.CHAIN'
231 include 'COMMON.DERIV'
233 include 'COMMON.INTERACT'
234 include 'COMMON.FFIELD'
236 include 'COMMON.QRESTR'
237 include 'COMMON.IOUNITS'
238 include 'COMMON.TIME1'
241 c This subrouting calculates total Cartesian coordinate gradient.
242 c The subroutine chainbuild_cart and energy MUST be called beforehand.
249 write (iout,*) "Before sum_gradient"
251 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
252 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
254 write (iout,*) "gsaxsc, gsaxcx"
256 write (iout,*) i," gsaxsc ",(gsaxsc(j,i),j=1,3)
257 write (iout,*) i," gsaxsx ",(gsaxsx(j,i),j=1,3)
264 write (iout,*) "After sum_gradient"
266 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
267 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
270 c If performing constraint dynamics, add the gradients of the constraint energy
271 if(usampl.and.totT.gt.eq_time) then
273 write (iout,*) "dudconst, duscdiff, dugamma,dutheta"
274 write (iout,*) "wumb",wumb
276 write (iout,'(i5,3f10.5,5x,3f10.5,5x,2f10.5)')
277 & i,(dudconst(j,i),j=1,3),(duscdiff(j,i),j=1,3),
278 & dugamma(i),dutheta(i)
283 gradc(j,i,icg)=gradc(j,i,icg)+
284 & wumb*(dudconst(j,i)+duscdiff(j,i))
285 gradx(j,i,icg)=gradx(j,i,icg)+
286 & wumb*(dudxconst(j,i)+duscdiffx(j,i))
290 gloc(i,icg)=gloc(i,icg)+wumb*dugamma(i)
293 gloc(nphi+i,icg)=gloc(nphi+i,icg)+wumb*dutheta(i)
301 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
303 cd call checkintcartgrad
304 cd write(iout,*) 'calling int_to_cart'
306 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
310 gcart(j,i)=gradc(j,i,icg)
311 gxcart(j,i)=gradx(j,i,icg)
314 if((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
315 write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
316 & (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg),
317 & gloc(ialph(i,1),icg),gloc(ialph(i,1)+nside,icg)
319 write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
320 & (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg)
330 time_inttocart=time_inttocart+MPI_Wtime()-time01
333 write (iout,*) "gcart and gxcart after int_to_cart"
335 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
336 & (gxcart(j,i),j=1,3)
340 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
344 c---------------------------------------------------------------------------
346 subroutine grad_transform
352 include 'COMMON.CONTROL'
353 include 'COMMON.CHAIN'
354 include 'COMMON.DERIV'
356 include 'COMMON.INTERACT'
357 include 'COMMON.FFIELD'
359 include 'COMMON.QRESTR'
360 include 'COMMON.IOUNITS'
361 include 'COMMON.TIME1'
364 write (iout,*)"Converting virtual-bond gradient to CA/SC gradient"
368 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
369 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
371 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
372 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
374 ! Correction: dummy residues
377 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
380 if (nct.lt.nres) then
382 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
383 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
387 write (iout,*) "CA/SC gradient"
389 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
390 & (gxcart(j,i),j=1,3)
396 C-------------------------------------------------------------------------
400 include 'COMMON.DERIV'
401 include 'COMMON.CHAIN'
404 include 'COMMON.SCCOR'
405 include 'COMMON.SHIELD'
406 integer i,j,kk,intertyp,maxshieldlist
409 C Initialize Cartesian-coordinate gradient
417 gvdwc_scpp(j,i)=0.0d0
419 C below is zero grad for shielding in order: ees (p-p)
420 C ecorr4, eturn3, eturn4, eel_loc, c denotes calfa,x is side-chain
423 gshieldc_loc(j,i)=0.0d0
424 gshieldx_ec(j,i)=0.0d0
425 gshieldc_ec(j,i)=0.0d0
426 gshieldc_loc_ec(j,i)=0.0d0
427 gshieldx_t3(j,i)=0.0d0
428 gshieldc_t3(j,i)=0.0d0
429 gshieldc_loc_t3(j,i)=0.0d0
430 gshieldx_t4(j,i)=0.0d0
431 gshieldc_t4(j,i)=0.0d0
432 gshieldc_loc_t4(j,i)=0.0d0
433 gshieldx_ll(j,i)=0.0d0
434 gshieldc_ll(j,i)=0.0d0
435 gshieldc_loc_ll(j,i)=0.0d0
436 C end of zero grad for shielding
442 gel_loc_long(j,i)=0.0d0
447 gcorr3_turn(j,i)=0.0d0
448 gcorr4_turn(j,i)=0.0d0
450 gradcorr_long(j,i)=0.0d0
451 gradcorr5_long(j,i)=0.0d0
452 gradcorr6_long(j,i)=0.0d0
453 gcorr6_turn_long(j,i)=0.0d0
456 gcorr6_turn(j,i)=0.0d0
466 grad_shield(j,i)=0.0d0
468 gg_tube_sc(j,i)=0.0d0
469 C grad_shield_side is Cbeta sidechain gradient
470 do kk=1,maxshieldlist
471 grad_shield_side(j,kk,i)=0.0d0
472 grad_shield_loc(j,kk,i)=0.0d0
474 C grad_shield_side_ca is Calfa sidechain gradient
477 C grad_shield_side_ca(j,kk,i)=0.0d0
480 gloc_sc(intertyp,i,icg)=0.0d0
495 C Initialize the gradient of local energy terms.
505 gel_loc_turn3(i)=0.0d0
506 gel_loc_turn4(i)=0.0d0
507 gel_loc_turn6(i)=0.0d0
510 c initialize gcart and gxcart
519 c-------------------------------------------------------------------------
520 double precision function fdum()