1 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
2 implicit real*8 (a-h,o-z)
4 include 'COMMON.CONTROL'
8 include 'COMMON.INTERACT'
9 include 'COMMON.FFIELD'
11 include 'COMMON.QRESTR'
12 include 'COMMON.IOUNITS'
15 double precision urparm(1)
16 dimension x(maxvar),g(maxvar)
18 c This subroutine calculates total internal coordinate gradient.
19 c Depending on the number of function evaluations, either whole energy
20 c is evaluated beforehand, Cartesian coordinates and their derivatives in
21 c internal coordinates are reevaluated or only the cartesian-in-internal
22 c coordinate derivatives are evaluated. The subroutine was designed to work
28 cd print *,'grad',nf,icg
29 if (nf-nfl+1) 20,30,40
30 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
31 c write (iout,*) 'grad 20'
34 30 call var_to_geom(n,x)
36 c write (iout,*) 'grad 30'
38 C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
41 c write (iout,*) 'grad 40'
42 c print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
44 C Convert the Cartesian gradient into internal-coordinate gradient.
54 c print *,'GRAD: i=',i,' jc=',j,' ind=',ind
56 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
59 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
65 c print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
67 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
68 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
71 if (i.gt.1) g(i-1)=gphii
72 if (n.gt.nphi) g(nphi+i)=gthetai
74 if (n.le.nphi+ntheta) goto 10
76 if (itype(i).ne.10) then
80 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
83 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
86 g(ialph(i,1)+nside)=gomegai
90 C Add the components corresponding to local energy terms.
93 c Add the usampl contributions
96 gloc(i,icg)=gloc(i,icg)+dugamma(i)
99 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
103 cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
104 g(i)=g(i)+gloc(i,icg)
106 C Uncomment following three lines for diagnostics.
108 cd call briefout(0,0.0d0)
109 cd write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
112 C-------------------------------------------------------------------------
113 subroutine grad_restr(n,x,nf,g,uiparm,urparm,ufparm)
114 implicit real*8 (a-h,o-z)
116 include 'COMMON.CHAIN'
117 include 'COMMON.DERIV'
119 include 'COMMON.INTERACT'
120 include 'COMMON.FFIELD'
121 include 'COMMON.IOUNITS'
124 double precision urparm(1)
125 dimension x(maxvar),g(maxvar)
128 if (nf-nfl+1) 20,30,40
129 20 call func_restr(n,x,nf,f,uiparm,urparm,ufparm)
130 c write (iout,*) 'grad 20'
135 c Intercept NaNs in the coordinates
136 c write(iout,*) (var(i),i=1,nvar)
141 if (x_sum.ne.x_sum) then
142 write(iout,*)" *** grad_restr : Found NaN in coordinates"
144 print *," *** grad_restr : Found NaN in coordinates"
148 call var_to_geom_restr(n,x)
151 C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
155 C Convert the Cartesian gradient into internal-coordinate gradient.
161 IF (mask_phi(i+2).eq.1) THEN
166 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
167 gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
180 IF (mask_theta(i+2).eq.1) THEN
186 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
187 gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
197 if (itype(i).ne.10) then
198 IF (mask_side(i).eq.1) THEN
202 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
211 if (itype(i).ne.10) then
212 IF (mask_side(i).eq.1) THEN
216 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
224 C Add the components corresponding to local energy terms.
231 if (mask_phi(i).eq.1) then
233 g(ig)=g(ig)+gloc(igall,icg)
239 if (mask_theta(i).eq.1) then
241 g(ig)=g(ig)+gloc(igall,icg)
247 if (itype(i).ne.10) then
249 if (mask_side(i).eq.1) then
251 g(ig)=g(ig)+gloc(igall,icg)
258 cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
262 C-------------------------------------------------------------------------
264 implicit real*8 (a-h,o-z)
269 include 'COMMON.CONTROL'
270 include 'COMMON.CHAIN'
271 include 'COMMON.DERIV'
273 include 'COMMON.INTERACT'
274 include 'COMMON.FFIELD'
276 include 'COMMON.HOMOLOGY'
277 include 'COMMON.QRESTR'
278 include 'COMMON.IOUNITS'
279 include 'COMMON.TIME1'
281 c This subrouting calculates total Cartesian coordinate gradient.
282 c The subroutine chainbuild_cart and energy MUST be called beforehand.
289 write (iout,*) "Before sum_gradient"
291 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
292 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
294 write (iout,*) "gsaxsc, gsaxcx"
296 write (iout,*) i," gsaxsc ",(gsaxsc(j,i),j=1,3)
297 write (iout,*) i," gsaxsx ",(gsaxsx(j,i),j=1,3)
304 write (iout,*) "After sum_gradient"
306 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
307 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
310 c If performing constraint dynamics, add the gradients of the constraint energy
311 if(usampl.and.totT.gt.eq_time) then
313 write (iout,*) "dudconst, duscdiff, dugamma,dutheta"
314 write (iout,*) "wumb",wumb
316 write (iout,'(i5,3f10.5,5x,3f10.5,5x,2f10.5)')
317 & i,(dudconst(j,i),j=1,3),(duscdiff(j,i),j=1,3),
318 & dugamma(i),dutheta(i)
323 gradc(j,i,icg)=gradc(j,i,icg)+
324 & wumb*(dudconst(j,i)+duscdiff(j,i))
325 gradx(j,i,icg)=gradx(j,i,icg)+
326 & wumb*(dudxconst(j,i)+duscdiffx(j,i))
330 gloc(i,icg)=gloc(i,icg)+wumb*dugamma(i)
333 gloc(nphi+i,icg)=gloc(nphi+i,icg)+wumb*dutheta(i)
341 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
343 cd call checkintcartgrad
344 cd write(iout,*) 'calling int_to_cart'
346 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
350 gcart(j,i)=gradc(j,i,icg)
351 gxcart(j,i)=gradx(j,i,icg)
354 if((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
355 write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
356 & (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg),
357 & gloc(ialph(i,1),icg),gloc(ialph(i,1)+nside,icg)
359 write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
360 & (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg)
370 time_inttocart=time_inttocart+MPI_Wtime()-time01
373 write (iout,*) "gcart and gxcart after int_to_cart"
375 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
376 & (gxcart(j,i),j=1,3)
380 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
384 C-------------------------------------------------------------------------
386 implicit real*8 (a-h,o-z)
388 include 'COMMON.DERIV'
389 include 'COMMON.CHAIN'
392 include 'COMMON.SCCOR'
393 include 'COMMON.SHIELD'
396 C Initialize Cartesian-coordinate gradient
404 gvdwc_scpp(j,i)=0.0d0
406 C below is zero grad for shielding in order: ees (p-p)
407 C ecorr4, eturn3, eturn4, eel_loc, c denotes calfa,x is side-chain
410 gshieldc_loc(j,i)=0.0d0
411 gshieldx_ec(j,i)=0.0d0
412 gshieldc_ec(j,i)=0.0d0
413 gshieldc_loc_ec(j,i)=0.0d0
414 gshieldx_t3(j,i)=0.0d0
415 gshieldc_t3(j,i)=0.0d0
416 gshieldc_loc_t3(j,i)=0.0d0
417 gshieldx_t4(j,i)=0.0d0
418 gshieldc_t4(j,i)=0.0d0
419 gshieldc_loc_t4(j,i)=0.0d0
420 gshieldx_ll(j,i)=0.0d0
421 gshieldc_ll(j,i)=0.0d0
422 gshieldc_loc_ll(j,i)=0.0d0
423 C end of zero grad for shielding
429 gel_loc_long(j,i)=0.0d0
434 gcorr3_turn(j,i)=0.0d0
435 gcorr4_turn(j,i)=0.0d0
437 gradcorr_long(j,i)=0.0d0
438 gradcorr5_long(j,i)=0.0d0
439 gradcorr6_long(j,i)=0.0d0
440 gcorr6_turn_long(j,i)=0.0d0
443 gcorr6_turn(j,i)=0.0d0
453 grad_shield(j,i)=0.0d0
455 gg_tube_sc(j,i)=0.0d0
456 C grad_shield_side is Cbeta sidechain gradient
457 do kk=1,maxshieldlist
458 grad_shield_side(j,kk,i)=0.0d0
459 grad_shield_loc(j,kk,i)=0.0d0
461 C grad_shield_side_ca is Calfa sidechain gradient
464 C grad_shield_side_ca(j,kk,i)=0.0d0
467 gloc_sc(intertyp,i,icg)=0.0d0
482 C Initialize the gradient of local energy terms.
492 gel_loc_turn3(i)=0.0d0
493 gel_loc_turn4(i)=0.0d0
494 gel_loc_turn6(i)=0.0d0
497 c initialize gcart and gxcart
506 c-------------------------------------------------------------------------
507 double precision function fdum()