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'
11 include 'COMMON.SCCOR'
14 double precision urparm(1)
15 dimension x(maxvar),g(maxvar)
17 c This subroutine calculates total internal coordinate gradient.
18 c Depending on the number of function evaluations, either whole energy
19 c is evaluated beforehand, Cartesian coordinates and their derivatives in
20 c internal coordinates are reevaluated or only the cartesian-in-internal
21 c coordinate derivatives are evaluated. The subroutine was designed to work
27 cd print *,'grad',nf,icg
28 if (nf-nfl+1) 20,30,40
29 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
30 c write (iout,*) 'grad 20'
33 30 call var_to_geom(n,x)
35 c write (iout,*) 'grad 30'
37 C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
40 c write (iout,*) 'grad 40'
41 c print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
43 C Convert the Cartesian gradient into internal-coordinate gradient.
53 c print *,'GRAD: i=',i,' jc=',j,' ind=',ind
55 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
58 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
64 c print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
66 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
67 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
70 if (i.gt.1) g(i-1)=gphii
71 if (n.gt.nphi) g(nphi+i)=gthetai
73 if (n.le.nphi+ntheta) goto 10
75 if (itype(i).ne.10) then
79 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
82 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
85 g(ialph(i,1)+nside)=gomegai
89 C Add the components corresponding to local energy terms.
93 cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
96 C Uncomment following three lines for diagnostics.
98 cd call briefout(0,0.0d0)
99 cd write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
102 C-------------------------------------------------------------------------
103 subroutine grad_restr(n,x,nf,g,uiparm,urparm,ufparm)
104 implicit real*8 (a-h,o-z)
106 include 'COMMON.CHAIN'
107 include 'COMMON.DERIV'
109 include 'COMMON.INTERACT'
110 include 'COMMON.FFIELD'
111 include 'COMMON.IOUNITS'
114 double precision urparm(1)
115 dimension x(maxvar),g(maxvar)
118 if (nf-nfl+1) 20,30,40
119 20 call func_restr(n,x,nf,f,uiparm,urparm,ufparm)
120 c write (iout,*) 'grad 20'
125 c Intercept NaNs in the coordinates
126 c write(iout,*) (var(i),i=1,nvar)
131 if (x_sum.ne.x_sum) then
132 write(iout,*)" *** grad_restr : Found NaN in coordinates"
134 print *," *** grad_restr : Found NaN in coordinates"
138 call var_to_geom_restr(n,x)
141 C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
145 C Convert the Cartesian gradient into internal-coordinate gradient.
151 IF (mask_phi(i+2).eq.1) THEN
156 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
157 gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
170 IF (mask_theta(i+2).eq.1) THEN
176 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
177 gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
187 if (itype(i).ne.10) then
188 IF (mask_side(i).eq.1) THEN
192 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
201 if (itype(i).ne.10) then
202 IF (mask_side(i).eq.1) THEN
206 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
214 C Add the components corresponding to local energy terms.
221 if (mask_phi(i).eq.1) then
223 g(ig)=g(ig)+gloc(igall,icg)
229 if (mask_theta(i).eq.1) then
231 g(ig)=g(ig)+gloc(igall,icg)
237 if (itype(i).ne.10) then
239 if (mask_side(i).eq.1) then
241 g(ig)=g(ig)+gloc(igall,icg)
248 cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
252 C-------------------------------------------------------------------------
254 implicit real*8 (a-h,o-z)
256 c integer iistart,iiend
259 include 'COMMON.LOCAL'
263 include 'COMMON.CONTROL'
264 include 'COMMON.CHAIN'
265 include 'COMMON.DERIV'
267 include 'COMMON.INTERACT'
268 include 'COMMON.FFIELD'
270 include 'COMMON.IOUNITS'
271 include 'COMMON.TIME1'
272 include 'COMMON.SCCOR'
274 c This subrouting calculates total Cartesian coordinate gradient.
275 c The subroutine chainbuild_cart and energy MUST be called beforehand.
278 c write (iout,*) "przed sum_grad", gloc_sc(1,i,icg),gloc(i,icg)
286 c write (iout,*) "in cartgrad before sum_: duscdiff and duscdiffx"
287 write (iout,*) "------ Before call sum_ in cargrad ------"
289 write (iout,*) i,(duscdiff(j,i),j=1,3)
290 write (iout,*) i,(duscdiffx(j,i),j=1,3)
291 write (iout,*) "nphi+i",nphi+i," gloc",gloc(nphi+i,icg)
292 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
293 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
301 c write (iout,*) "checkgrad", gloc_sc(1,i,icg),gloc(i,icg)
304 write (iout,*) "------ After sum_gradient in cartgrad ------"
307 write (iout,*) "nphi+i",nphi+i," gloc",gloc(nphi+i,icg)
308 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
309 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
312 c If performing constraint dynamics, add the gradients of the constraint energy
314 write (iout,*) "in cartgrad: dutheta, duscdiff and duscdiffx"
316 write (iout,*) i,dutheta(i)
317 write (iout,*) i,(duscdiff(j,i),j=1,3)
318 write (iout,*) i,(duscdiffx(j,i),j=1,3)
321 if(usampl.and.totT.gt.eq_time) then
322 c if(usampl.and.totT.gt.eq_time .or. constr_homology.gt.0) then
324 c Setting suited bounds for HM restrs
328 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)
329 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)
332 write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3)
333 write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3)
337 gloc(i,icg)=gloc(i,icg)+dugamma(i)
341 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
343 write (iout,*) "nphi+i",nphi+i," gloc",gloc(nphi+i,icg)
352 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
354 cd call checkintcartgrad
355 cd write(iout,*) 'calling int_to_cart'
356 cd write (iout,*) "gcart, gxcart, gloc before int_to_cart"
359 gcart(j,i)=gradc(j,i,icg)
360 gxcart(j,i)=gradx(j,i,icg)
362 cd write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),
363 cd & (gxcart(j,i),j=1,3),gloc(i,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'
394 C Initialize Cartesian-coordinate gradient
404 gvdwc_scpp(j,i)=0.0d0
411 gel_loc_long(j,i)=0.0d0
414 gcorr3_turn(j,i)=0.0d0
415 gcorr4_turn(j,i)=0.0d0
417 gradcorr_long(j,i)=0.0d0
418 gradcorr5_long(j,i)=0.0d0
419 gradcorr6_long(j,i)=0.0d0
420 gcorr6_turn_long(j,i)=0.0d0
423 gcorr6_turn(j,i)=0.0d0
431 gloc_sc(intertyp,i,icg)=0.0d0
442 c Initialize the gradients of local restraints
453 C Initialize the gradient of local energy terms.
463 gel_loc_turn3(i)=0.0d0
464 gel_loc_turn4(i)=0.0d0
465 gel_loc_turn6(i)=0.0d0
468 c initialize gcart and gxcart
477 c-------------------------------------------------------------------------
478 double precision function fdum()