2 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
5 include 'COMMON.CONTROL'
9 include 'COMMON.INTERACT'
10 include 'COMMON.FFIELD'
12 include 'COMMON.QRESTR'
13 include 'COMMON.IOUNITS'
15 double precision ufparm
18 double precision urparm(1)
19 double precision x(n),g(n)
20 integer i,j,k,ind,ind1
21 double precision f,gthetai,gphii,galphai,gomegai
23 c This subroutine calculates total internal coordinate gradient.
24 c Depending on the number of function evaluations, either whole energy
25 c is evaluated beforehand, Cartesian coordinates and their derivatives in
26 c internal coordinates are reevaluated or only the cartesian-in-internal
27 c coordinate derivatives are evaluated. The subroutine was designed to work
33 cd print *,'grad',nf,icg
34 if (nf-nfl+1) 20,30,40
35 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
36 c write (iout,*) 'grad 20'
39 30 call var_to_geom(n,x)
40 call chainbuild_extconf
41 c write (iout,*) 'grad 30'
43 C Transform the gradient to the gradient in angles.
45 40 call cart2intgrad(n,g)
47 C Add the components corresponding to local energy terms.
50 c Add the usampl contributions
53 gloc(i,icg)=gloc(i,icg)+dugamma(i)
56 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
60 cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
63 C Uncomment following three lines for diagnostics.
65 cd call briefout(0,0.0d0)
66 cd write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
69 C-------------------------------------------------------------------------
70 subroutine grad_restr(n,x,nf,g,uiparm,urparm,ufparm)
73 include 'COMMON.CHAIN'
74 include 'COMMON.DERIV'
76 include 'COMMON.INTERACT'
77 include 'COMMON.FFIELD'
78 include 'COMMON.IOUNITS'
80 double precision ufparm
83 double precision urparm(1)
84 double precision x(maxvar),g(maxvar),gg(maxvar)
85 integer i,j,k,ig,ind,ij,igall
86 double precision f,gthetai,gphii,galphai,gomegai
89 if (nf-nfl+1) 20,30,40
90 20 call func_restr(n,x,nf,f,uiparm,urparm,ufparm)
91 c write (iout,*) 'grad 20'
96 c Intercept NaNs in the coordinates
97 c write(iout,*) (var(i),i=1,nvar)
102 if (x_sum.ne.x_sum) then
103 write(iout,*)" *** grad_restr : Found NaN in coordinates"
105 print *," *** grad_restr : Found NaN in coordinates"
109 call var_to_geom_restr(n,x)
112 C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
114 40 call cart2intgrad(n,gg)
116 C Convert the Cartesian gradient into internal-coordinate gradient.
122 IF (mask_phi(i+2).eq.1) THEN
130 IF (mask_theta(i+2).eq.1) THEN
137 if (itype(i).ne.10) then
138 IF (mask_side(i).eq.1) THEN
147 if (itype(i).ne.10) then
148 IF (mask_side(i).eq.1) THEN
150 g(ig)=gg(ialph(i,1)+nside)
156 C Add the components corresponding to local energy terms.
163 if (mask_phi(i).eq.1) then
165 g(ig)=g(ig)+gloc(igall,icg)
171 if (mask_theta(i).eq.1) then
173 g(ig)=g(ig)+gloc(igall,icg)
179 if (itype(i).ne.10) then
181 if (mask_side(i).eq.1) then
183 g(ig)=g(ig)+gloc(igall,icg)
190 cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
195 C-------------------------------------------------------------------------
202 include 'COMMON.CONTROL'
203 include 'COMMON.CHAIN'
204 include 'COMMON.DERIV'
206 include 'COMMON.INTERACT'
207 include 'COMMON.FFIELD'
209 include 'COMMON.QRESTR'
210 include 'COMMON.IOUNITS'
211 include 'COMMON.TIME1'
213 double precision time00,time01
215 c This subrouting calculates total Cartesian coordinate gradient.
216 c The subroutine chainbuild_cart and energy MUST be called beforehand.
223 write (iout,*) "Before sum_gradient"
225 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
226 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
228 write (iout,*) "gsaxsc, gsaxcx"
230 write (iout,*) i," gsaxsc ",(gsaxsc(j,i),j=1,3)
231 write (iout,*) i," gsaxsx ",(gsaxsx(j,i),j=1,3)
238 write (iout,*) "After sum_gradient"
240 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
241 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
244 c If performing constraint dynamics, add the gradients of the constraint energy
245 if(usampl.and.totT.gt.eq_time) then
247 write (iout,*) "dudconst, duscdiff, dugamma,dutheta"
248 write (iout,*) "wumb",wumb
250 write (iout,'(i5,3f10.5,5x,3f10.5,5x,2f10.5)')
251 & i,(dudconst(j,i),j=1,3),(duscdiff(j,i),j=1,3),
252 & dugamma(i),dutheta(i)
257 gradc(j,i,icg)=gradc(j,i,icg)+
258 & wumb*(dudconst(j,i)+duscdiff(j,i))
259 gradx(j,i,icg)=gradx(j,i,icg)+
260 & wumb*(dudxconst(j,i)+duscdiffx(j,i))
264 gloc(i,icg)=gloc(i,icg)+wumb*dugamma(i)
267 gloc(nphi+i,icg)=gloc(nphi+i,icg)+wumb*dutheta(i)
275 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
277 cd call checkintcartgrad
278 cd write(iout,*) 'calling int_to_cart'
280 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
284 gcart(j,i)=gradc(j,i,icg)
285 gxcart(j,i)=gradx(j,i,icg)
289 write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
290 & (gxcart(j,i),j=1,3)
291 else if((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
292 write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
293 & (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg),
294 & gloc(ialph(i,1),icg),gloc(ialph(i,1)+nside,icg)
296 write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
297 & (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg)
307 time_inttocart=time_inttocart+MPI_Wtime()-time01
310 write (iout,*) "gcart and gxcart after int_to_cart"
312 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
313 & (gxcart(j,i),j=1,3)
317 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
321 c---------------------------------------------------------------------------
323 subroutine grad_transform
329 include 'COMMON.CONTROL'
330 include 'COMMON.CHAIN'
331 include 'COMMON.DERIV'
333 include 'COMMON.INTERACT'
334 include 'COMMON.FFIELD'
336 include 'COMMON.QRESTR'
337 include 'COMMON.IOUNITS'
338 include 'COMMON.TIME1'
341 write (iout,*)"Converting virtual-bond gradient to CA/SC gradient"
342 write (iout,*) "dC/dX gradient"
344 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
345 & (gxcart(j,i),j=1,3)
350 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
351 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
353 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
354 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
356 ! Correction: dummy residues
358 if (itype(i-1).eq.ntyp1 .and. itype(i).ne.ntyp1) then
359 gcart(:,i)=gcart(:,i)+gcart(:,i-1)
360 else if (itype(i-1).ne.ntyp1 .and. itype(i).eq.ntyp1) then
361 gcart(:,i-1)=gcart(:,i-1)+gcart(:,i)
366 c gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
369 c if (nct.lt.nres) then
371 c! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
372 c gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
376 write (iout,*) "CA/SC gradient"
378 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
379 & (gxcart(j,i),j=1,3)
385 C-------------------------------------------------------------------------
389 include 'COMMON.DERIV'
390 include 'COMMON.CHAIN'
393 include 'COMMON.SCCOR'
394 include 'COMMON.SHIELD'
395 integer i,j,kk,intertyp,maxshieldlist
398 C Initialize Cartesian-coordinate gradient
406 gvdwc_scpp(j,i)=0.0d0
408 C below is zero grad for shielding in order: ees (p-p)
409 C ecorr4, eturn3, eturn4, eel_loc, c denotes calfa,x is side-chain
412 gshieldc_loc(j,i)=0.0d0
413 gshieldx_ec(j,i)=0.0d0
414 gshieldc_ec(j,i)=0.0d0
415 gshieldc_loc_ec(j,i)=0.0d0
416 gshieldx_t3(j,i)=0.0d0
417 gshieldc_t3(j,i)=0.0d0
418 gshieldc_loc_t3(j,i)=0.0d0
419 gshieldx_t4(j,i)=0.0d0
420 gshieldc_t4(j,i)=0.0d0
421 gshieldc_loc_t4(j,i)=0.0d0
422 gshieldx_ll(j,i)=0.0d0
423 gshieldc_ll(j,i)=0.0d0
424 gshieldc_loc_ll(j,i)=0.0d0
425 C end of zero grad for shielding
431 gel_loc_long(j,i)=0.0d0
436 gcorr3_turn(j,i)=0.0d0
437 gcorr4_turn(j,i)=0.0d0
439 gradcorr_long(j,i)=0.0d0
440 gradcorr5_long(j,i)=0.0d0
441 gradcorr6_long(j,i)=0.0d0
442 gcorr6_turn_long(j,i)=0.0d0
445 gcorr6_turn(j,i)=0.0d0
455 grad_shield(j,i)=0.0d0
457 gg_tube_sc(j,i)=0.0d0
458 C grad_shield_side is Cbeta sidechain gradient
459 do kk=1,maxshieldlist
460 grad_shield_side(j,kk,i)=0.0d0
461 grad_shield_loc(j,kk,i)=0.0d0
463 C grad_shield_side_ca is Calfa sidechain gradient
466 C grad_shield_side_ca(j,kk,i)=0.0d0
469 gloc_sc(intertyp,i,icg)=0.0d0
484 C Initialize the gradient of local energy terms.
494 gel_loc_turn3(i)=0.0d0
495 gel_loc_turn4(i)=0.0d0
496 gel_loc_turn6(i)=0.0d0
499 c initialize gcart and gxcart
508 c-------------------------------------------------------------------------
509 double precision function fdum()