1 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
2 implicit real*8 (a-h,o-z)
7 include 'COMMON.INTERACT'
8 include 'COMMON.FFIELD'
10 include 'COMMON.IOUNITS'
13 double precision urparm(1)
14 dimension x(maxvar),g(maxvar)
16 c This subroutine calculates total internal coordinate gradient.
17 c Depending on the number of function evaluations, either whole energy
18 c is evaluated beforehand, Cartesian coordinates and their derivatives in
19 c internal coordinates are reevaluated or only the cartesian-in-internal
20 c coordinate derivatives are evaluated. The subroutine was designed to work
26 cd print *,'grad',nf,icg
27 if (nf-nfl+1) 20,30,40
28 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
29 c write (iout,*) 'grad 20'
32 30 call var_to_geom(n,x)
34 c write (iout,*) 'grad 30'
36 C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
39 c write (iout,*) 'grad 40'
40 c print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
42 C Convert the Cartesian gradient into internal-coordinate gradient.
52 c print *,'GRAD: i=',i,' jc=',j,' ind=',ind
54 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
57 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
63 c print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
65 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
66 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
69 if (i.gt.1) g(i-1)=gphii
70 if (n.gt.nphi) g(nphi+i)=gthetai
72 if (n.le.nphi+ntheta) goto 10
74 if (itype(i).ne.10) then
78 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
81 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
84 g(ialph(i,1)+nside)=gomegai
88 C Add the components corresponding to local energy terms.
91 c Add the usampl contributions
94 gloc(i,icg)=gloc(i,icg)+dugamma(i)
97 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
101 cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
102 g(i)=g(i)+gloc(i,icg)
104 C Uncomment following three lines for diagnostics.
106 cd call briefout(0,0.0d0)
107 cd write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
110 C-------------------------------------------------------------------------
111 subroutine grad_restr(n,x,nf,g,uiparm,urparm,ufparm)
112 implicit real*8 (a-h,o-z)
114 include 'COMMON.CHAIN'
115 include 'COMMON.DERIV'
117 include 'COMMON.INTERACT'
118 include 'COMMON.FFIELD'
119 include 'COMMON.IOUNITS'
122 double precision urparm(1)
123 dimension x(maxvar),g(maxvar)
126 if (nf-nfl+1) 20,30,40
127 20 call func_restr(n,x,nf,f,uiparm,urparm,ufparm)
128 c write (iout,*) 'grad 20'
133 c Intercept NaNs in the coordinates
134 c write(iout,*) (var(i),i=1,nvar)
139 if (x_sum.ne.x_sum) then
140 write(iout,*)" *** grad_restr : Found NaN in coordinates"
142 print *," *** grad_restr : Found NaN in coordinates"
146 call var_to_geom_restr(n,x)
149 C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
153 C Convert the Cartesian gradient into internal-coordinate gradient.
159 IF (mask_phi(i+2).eq.1) THEN
164 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
165 gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
178 IF (mask_theta(i+2).eq.1) THEN
184 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
185 gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
195 if (itype(i).ne.10) then
196 IF (mask_side(i).eq.1) THEN
200 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
209 if (itype(i).ne.10) then
210 IF (mask_side(i).eq.1) THEN
214 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
222 C Add the components corresponding to local energy terms.
229 if (mask_phi(i).eq.1) then
231 g(ig)=g(ig)+gloc(igall,icg)
237 if (mask_theta(i).eq.1) then
239 g(ig)=g(ig)+gloc(igall,icg)
245 if (itype(i).ne.10) then
247 if (mask_side(i).eq.1) then
249 g(ig)=g(ig)+gloc(igall,icg)
256 cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
260 C-------------------------------------------------------------------------
262 implicit real*8 (a-h,o-z)
267 include 'COMMON.CHAIN'
268 include 'COMMON.DERIV'
270 include 'COMMON.INTERACT'
271 include 'COMMON.FFIELD'
273 include 'COMMON.IOUNITS'
274 include 'COMMON.TIME1'
276 c This subrouting calculates total Cartesian coordinate gradient.
277 c The subroutine chainbuild_cart and energy MUST be called beforehand.
284 write (iout,*) "Before sum_gradient"
286 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
287 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
289 write (iout,*) "gsaxsc, gsaxcx"
291 write (iout,*) i," gsaxsc ",(gsaxsc(j,i),j=1,3)
292 write (iout,*) i," gsaxsx ",(gsaxsx(j,i),j=1,3)
299 write (iout,*) "After sum_gradient"
301 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
302 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
305 c If performing constraint dynamics, add the gradients of the constraint energy
306 if(usampl.and.totT.gt.eq_time) then
308 write (iout,*) "dudconst, duscdiff, dugamma,dutheta"
309 write (iout,*) "wumb",wumb
311 write (iout,'(i5,3f10.5,5x,3f10.5,5x,2f10.5)')
312 & i,(dudconst(j,i),j=1,3),(duscdiff(j,i),j=1,3),
313 & dugamma(i),dutheta(i)
318 gradc(j,i,icg)=gradc(j,i,icg)+
319 & wumb*(dudconst(j,i)+duscdiff(j,i))
320 gradx(j,i,icg)=gradx(j,i,icg)+
321 & wumb*(dudxconst(j,i)+duscdiffx(j,i))
325 gloc(i,icg)=gloc(i,icg)+wumb*dugamma(i)
328 gloc(nphi+i,icg)=gloc(nphi+i,icg)+wumb*dutheta(i)
336 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
338 cd call checkintcartgrad
339 cd write(iout,*) 'calling int_to_cart'
341 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
345 gcart(j,i)=gradc(j,i,icg)
346 gxcart(j,i)=gradx(j,i,icg)
349 if((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
350 write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
351 & (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg),
352 & gloc(ialph(i,1),icg),gloc(ialph(i,1)+nside,icg)
354 write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
355 & (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg)
365 time_inttocart=time_inttocart+MPI_Wtime()-time01
368 write (iout,*) "gcart and gxcart after int_to_cart"
370 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
371 & (gxcart(j,i),j=1,3)
375 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
379 C-------------------------------------------------------------------------
381 implicit real*8 (a-h,o-z)
383 include 'COMMON.DERIV'
384 include 'COMMON.CHAIN'
387 include 'COMMON.SCCOR'
388 include 'COMMON.SHIELD'
391 C Initialize Cartesian-coordinate gradient
399 gvdwc_scpp(j,i)=0.0d0
401 C below is zero grad for shielding in order: ees (p-p)
402 C ecorr4, eturn3, eturn4, eel_loc, c denotes calfa,x is side-chain
405 gshieldc_loc(j,i)=0.0d0
406 gshieldx_ec(j,i)=0.0d0
407 gshieldc_ec(j,i)=0.0d0
408 gshieldc_loc_ec(j,i)=0.0d0
409 gshieldx_t3(j,i)=0.0d0
410 gshieldc_t3(j,i)=0.0d0
411 gshieldc_loc_t3(j,i)=0.0d0
412 gshieldx_t4(j,i)=0.0d0
413 gshieldc_t4(j,i)=0.0d0
414 gshieldc_loc_t4(j,i)=0.0d0
415 gshieldx_ll(j,i)=0.0d0
416 gshieldc_ll(j,i)=0.0d0
417 gshieldc_loc_ll(j,i)=0.0d0
418 C end of zero grad for shielding
424 gel_loc_long(j,i)=0.0d0
429 gcorr3_turn(j,i)=0.0d0
430 gcorr4_turn(j,i)=0.0d0
432 gradcorr_long(j,i)=0.0d0
433 gradcorr5_long(j,i)=0.0d0
434 gradcorr6_long(j,i)=0.0d0
435 gcorr6_turn_long(j,i)=0.0d0
438 gcorr6_turn(j,i)=0.0d0
448 grad_shield(j,i)=0.0d0
450 gg_tube_sc(j,i)=0.0d0
451 C grad_shield_side is Cbeta sidechain gradient
452 do kk=1,maxshieldlist
453 grad_shield_side(j,kk,i)=0.0d0
454 grad_shield_loc(j,kk,i)=0.0d0
456 C grad_shield_side_ca is Calfa sidechain gradient
459 C grad_shield_side_ca(j,kk,i)=0.0d0
462 gloc_sc(intertyp,i,icg)=0.0d0
467 C Initialize the gradient of local energy terms.
477 gel_loc_turn3(i)=0.0d0
478 gel_loc_turn4(i)=0.0d0
479 gel_loc_turn6(i)=0.0d0
482 c initialize gcart and gxcart
491 c-------------------------------------------------------------------------
492 double precision function fdum()