1 subroutine intcartderiv
2 implicit real*8 (a-h,o-z)
11 include 'COMMON.INTERACT'
12 include 'COMMON.DERIV'
13 include 'COMMON.IOUNITS'
14 include 'COMMON.LOCAL'
15 include 'COMMON.SCCOR'
16 double precision dcostheta(3,2,maxres),
17 & dcosphi(3,3,maxres),dsinphi(3,3,maxres),
18 & dcosalpha(3,3,maxres),dcosomega(3,3,maxres),
19 & dsinomega(3,3,maxres),vo1(3),vo2(3),vo3(3),
20 & dummy(3),vp1(3),vp2(3),vp3(3),vpp1(3),n(3)
22 #if defined(MPI) && defined(PARINTDER)
23 if (nfgtasks.gt.1 .and. me.eq.king)
24 & call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
29 c write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
30 c Derivatives of theta's
31 #if defined(MPI) && defined(PARINTDER)
32 c We need dtheta(:,:,i-1) to compute dphi(:,:,i)
33 do i=max0(ithet_start-1,3),ithet_end
38 sint=sqrt(1-cost*cost)
40 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/
42 dtheta(j,1,i)=-1/sint*dcostheta(j,1,i)
43 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/
45 dtheta(j,2,i)=-1/sint*dcostheta(j,2,i)
49 #if defined(MPI) && defined(PARINTDER)
50 c We need dtheta(:,:,i-1) to compute dphi(:,:,i)
51 do i=max0(ithet_start-1,3),ithet_end
55 if ((itype(i-1).ne.10).and.(itype(i-1).ne.21)) then
56 cost1=dcos(omicron(1,i))
57 sint1=sqrt(1-cost1*cost1)
58 cost2=dcos(omicron(2,i))
59 sint2=sqrt(1-cost2*cost2)
61 CC Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
62 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+
63 & cost1*dc_norm(j,i-2))/
65 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
66 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2)
67 & +cost1*(dc_norm(j,i-1+nres)))/
69 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
70 CC Calculate derivative over second omicron Sci-1,Cai-1 Cai
71 CC Looks messy but better than if in loop
72 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres)
73 & +cost2*dc_norm(j,i-1))/
75 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
76 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1)
77 & +cost2*(-dc_norm(j,i-1+nres)))/
79 c write(iout,*) "vbld", i,itype(i),vbld(i-1+nres)
80 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
88 c If phi is 0 or 180 degrees, then the formulas
89 c have to be derived by power series expansion of the
90 c conventional formulas around 0 and 180.
92 do i=iphi1_start,iphi1_end
96 c the conventional case
98 sint1=dsin(theta(i-1))
101 cost1=dcos(theta(i-1))
103 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
104 fac0=1.0d0/(sint1*sint)
107 fac3=cosg*cost1/(sint1*sint1)
108 fac4=cosg*cost/(sint*sint)
109 c Obtaining the gamma derivatives from sine derivative
110 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or.
111 & phi(i).gt.pi34.and.phi(i).le.pi.or.
112 & phi(i).gt.-pi.and.phi(i).le.-pi34) then
113 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
114 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
115 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
120 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1)
121 & -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
122 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
124 & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i))
125 & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
126 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
127 c Bug fixed 3/24/05 (AL)
128 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i)
129 & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
130 c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
131 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
133 c Obtaining the gamma derivatives from cosine derivative
136 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3*
137 & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp*
138 & dc_norm(j,i-3))/vbld(i-2)
139 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
140 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2*
141 & dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4*
143 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
144 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4*
145 & dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp*
146 & dc_norm(j,i-1))/vbld(i)
147 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
154 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
155 cc write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
158 Calculate derivative of Tauangle
160 do i=itau_start,itau_end
164 if ((itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle
165 cc dtauangle(j,intertyp,dervityp,residue number)
166 cc INTERTYP=1 SC...Ca...Ca..Ca
167 c the conventional case
169 sint1=dsin(omicron(2,i-1))
170 sing=dsin(tauangle(1,i))
172 cost1=dcos(omicron(2,i-1))
173 cosg=dcos(tauangle(1,i))
174 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
175 fac0=1.0d0/(sint1*sint)
178 fac3=cosg*cost1/(sint1*sint1)
179 fac4=cosg*cost/(sint*sint)
180 cc write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
181 c Obtaining the gamma derivatives from sine derivative
182 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or.
183 & tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or.
184 & tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
185 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
186 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
187 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
192 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1)
193 &-(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres)))
194 & *vbld_inv(i-2+nres)
195 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
197 & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i))
198 & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
199 c write(iout,*) "dsintau", dsintau(j,1,2,i)
200 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
201 c Bug fixed 3/24/05 (AL)
202 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i)
203 & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
204 c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
205 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
207 c Obtaining the gamma derivatives from cosine derivative
210 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3*
211 & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp*
212 & (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
213 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
214 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2*
215 & dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4*
217 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
218 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4*
219 & dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp*
220 & dc_norm(j,i-1))/vbld(i)
221 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
222 c write (iout,*) "else",i
226 c write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
229 CC Second case Ca...Ca...Ca...SC
231 do i=itau_start,itau_end
235 if ((itype(i-1).eq.21).or.(itype(i-1).eq.10)) cycle
236 c the conventional case
237 sint=dsin(omicron(1,i))
238 sint1=dsin(theta(i-1))
239 sing=dsin(tauangle(2,i))
240 cost=dcos(omicron(1,i))
241 cost1=dcos(theta(i-1))
242 cosg=dcos(tauangle(2,i))
244 c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
246 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
247 fac0=1.0d0/(sint1*sint)
250 fac3=cosg*cost1/(sint1*sint1)
251 fac4=cosg*cost/(sint*sint)
252 c Obtaining the gamma derivatives from sine derivative
253 c write (iout,*) "i",i," tauangle2",tauangle(2,i)
254 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or.
255 & tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or.
256 & tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
257 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
258 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
259 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
264 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1)
265 & +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
266 c write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
267 c &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
268 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
270 & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i))
271 & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
272 c write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
273 c & sing*ctgt*domicron(j,1,2,i),
274 c & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
275 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
276 c Bug fixed 3/24/05 (AL)
277 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i)
278 & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
279 c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
280 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
282 c Obtaining the gamma derivatives from cosine derivative
285 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3*
286 & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp*
287 & dc_norm(j,i-3))/vbld(i-2)
288 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
289 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2*
290 & dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4*
291 & dcosomicron(j,1,1,i)
292 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
293 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4*
294 & dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp*
295 & dc_norm(j,i-1+nres))/vbld(i-1+nres)
296 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
297 c write(iout,*) i,j,"else", dtauangle(j,2,3,i)
303 CCC third case SC...Ca...Ca...SC
306 do i=itau_start,itau_end
310 c the conventional case
311 if ((itype(i-1).eq.21).or.(itype(i-1).eq.10).or.
312 &(itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle
313 sint=dsin(omicron(1,i))
314 sint1=dsin(omicron(2,i-1))
315 sing=dsin(tauangle(3,i))
316 cost=dcos(omicron(1,i))
317 cost1=dcos(omicron(2,i-1))
318 cosg=dcos(tauangle(3,i))
320 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
321 c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
323 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
324 fac0=1.0d0/(sint1*sint)
327 fac3=cosg*cost1/(sint1*sint1)
328 fac4=cosg*cost/(sint*sint)
329 c Obtaining the gamma derivatives from sine derivative
330 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or.
331 & tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or.
332 & tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
333 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
334 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
335 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
340 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1)
341 & -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres))
342 & *vbld_inv(i-2+nres)
343 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
345 & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i))
346 & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
347 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
348 c Bug fixed 3/24/05 (AL)
349 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i)
350 & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))
351 & *vbld_inv(i-1+nres)
352 c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
353 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
355 c Obtaining the gamma derivatives from cosine derivative
358 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3*
359 & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp*
360 & dc_norm2(j,i-2+nres))/vbld(i-2+nres)
361 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
362 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2*
363 & dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4*
364 & dcosomicron(j,1,1,i)
365 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
366 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4*
367 & dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp*
368 & dc_norm(j,i-1+nres))/vbld(i-1+nres)
369 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
370 c write(iout,*) "else",i
375 c Derivatives of side-chain angles alpha and omega
376 #if defined(MPI) && defined(PARINTDER)
377 do i=ibond_start,ibond_end
381 if(itype(i).ne.10) then
382 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
386 fac9=fac5/vbld(i+nres)
387 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
388 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
389 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))*(
390 & scalar(dC_norm(1,i),dC_norm(1,i+nres))
391 & -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
392 sina=sqrt(1-cosa*cosa)
395 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)-
396 & dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
397 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
398 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)-
399 & scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
400 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
401 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)-
402 & dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/
404 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
406 c obtaining the derivatives of omega from sines
407 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or.
408 & omeg(i).gt.pi34.and.omeg(i).le.pi.or.
409 & omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
410 fac15=dcos(theta(i+1))/(dsin(theta(i+1))*
412 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
413 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
414 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
415 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
416 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
417 coso_inv=1.0d0/dcos(omeg(i))
419 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1)
420 & +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)-(
421 & sino*dc_norm(j,i-1))/vbld(i)
422 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
423 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1)
424 & +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j)
425 & -sino*dc_norm(j,i)/vbld(i+1)
426 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
427 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)-
428 & fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/
430 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
433 c obtaining the derivatives of omega from cosines
434 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
435 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
440 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11*
441 & dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+
442 & (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina*
443 & fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
444 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
445 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2*
446 & dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11*
447 & dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+
448 & (scala2-fac11*cosa)*(0.25d0*sina/fac10*
449 & dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)
451 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
452 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)-
453 & scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+
454 & (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
455 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
461 #if defined(MPI) && defined(PARINTDER)
462 if (nfgtasks.gt.1) then
464 write (iout,*) "Gather dtheta"
466 c write (iout,*) "dtheta before gather"
468 c write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
471 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),
472 & MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,
473 & king,FG_COMM,IERROR)
475 cd write (iout,*) "Gather dphi"
477 write (iout,*) "dphi before gather"
479 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
482 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),
483 & MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,
484 & king,FG_COMM,IERROR)
485 cd write (iout,*) "Gather dalpha"
488 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),
489 & MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,
490 & king,FG_COMM,IERROR)
491 cd write (iout,*) "Gather domega"
493 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),
494 & MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,
495 & king,FG_COMM,IERROR)
500 write (iout,*) "dtheta after gather"
502 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),j=1,2)
504 write (iout,*) "dphi after gather"
506 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
512 subroutine checkintcartgrad
513 implicit real*8 (a-h,o-z)
518 include 'COMMON.CHAIN'
521 include 'COMMON.INTERACT'
522 include 'COMMON.DERIV'
523 include 'COMMON.IOUNITS'
524 include 'COMMON.SETUP'
525 double precision dthetanum(3,2,maxres),dphinum(3,3,maxres)
526 & ,dalphanum(3,3,maxres), domeganum(3,3,maxres)
527 double precision theta_s(maxres),phi_s(maxres),alph_s(maxres),
528 & omeg_s(maxres),dc_norm_s(3)
529 double precision aincr /1.0d-5/
537 c Check theta gradient
539 & "Analytical (upper) and numerical (lower) gradient of theta"
546 call int_from_cart1(.false.)
547 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
550 dc(j,i-1)=dc(j,i-1)+aincr
552 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
555 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),
556 & (dtheta(j,2,i),j=1,3)
557 write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),
558 & (dthetanum(j,2,i),j=1,3)
559 write (iout,'(5x,3f10.5,5x,3f10.5)')
560 & (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),
561 & (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
564 c Check gamma gradient
566 & "Analytical (upper) and numerical (lower) gradient of gamma"
572 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
577 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
580 dc(j,i-1)=dc(j,i-1)+aincr
582 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
585 write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),
586 & (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
587 write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),
588 & (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
589 write (iout,'(5x,3(3f10.5,5x))')
590 & (dphinum(j,1,i)/dphi(j,1,i),j=1,3),
591 & (dphinum(j,2,i)/dphi(j,2,i),j=1,3),
592 & (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
595 c Check alpha gradient
597 & "Analytical (upper) and numerical (lower) gradient of alpha"
599 if(itype(i).ne.10) then
604 dalphanum(j,1,i)=(alph(i)-alph_s(i))
610 dalphanum(j,2,i)=(alph(i)-alph_s(i))
614 dc(j,i+nres)=dc(j,i+nres)+aincr
616 dalphanum(j,3,i)=(alph(i)-alph_s(i))
621 write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),
622 & (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
623 write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),
624 & (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
625 write (iout,'(5x,3(3f10.5,5x))')
626 & (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),
627 & (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),
628 & (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
631 c Check omega gradient
633 & "Analytical (upper) and numerical (lower) gradient of omega"
635 if(itype(i).ne.10) then
640 domeganum(j,1,i)=(omeg(i)-omeg_s(i))
646 domeganum(j,2,i)=(omeg(i)-omeg_s(i))
650 dc(j,i+nres)=dc(j,i+nres)+aincr
652 domeganum(j,3,i)=(omeg(i)-omeg_s(i))
657 write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),
658 & (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
659 write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),
660 & (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
661 write (iout,'(5x,3(3f10.5,5x))')
662 & (domeganum(j,1,i)/domega(j,1,i),j=1,3),
663 & (domeganum(j,2,i)/domega(j,2,i),j=1,3),
664 & (domeganum(j,3,i)/domega(j,3,i),j=1,3)
670 subroutine chainbuild_cart
671 implicit real*8 (a-h,o-z)
676 include 'COMMON.SETUP'
677 include 'COMMON.CHAIN'
678 include 'COMMON.LOCAL'
679 include 'COMMON.TIME1'
680 include 'COMMON.IOUNITS'
683 if (nfgtasks.gt.1) then
684 c write (iout,*) "BCAST in chainbuild_cart"
686 c Broadcast the order to build the chain and compute internal coordinates
687 c to the slaves. The slaves receive the order in ERGASTULUM.
689 c write (iout,*) "CHAINBUILD_CART: DC before BCAST"
691 c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3),
692 c & (dc(j,i+nres),j=1,3)
695 & call MPI_Bcast(7,1,MPI_INTEGER,king,FG_COMM,IERROR)
696 time_bcast7=time_bcast7+MPI_Wtime()-time00
698 call MPI_Bcast(dc(1,0),6*(nres+1),MPI_DOUBLE_PRECISION,
700 c write (iout,*) "CHAINBUILD_CART: DC after BCAST"
702 c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3),
703 c & (dc(j,i+nres),j=1,3)
705 c write (iout,*) "End BCAST in chainbuild_cart"
707 time_bcast=time_bcast+MPI_Wtime()-time00
708 time_bcastc=time_bcastc+MPI_Wtime()-time01
716 c(j,i)=c(j,i-1)+dc(j,i-1)
721 c(j,i+nres)=c(j,i)+dc(j,i+nres)
724 c write (iout,*) "CHAINBUILD_CART"
726 call int_from_cart1(.false.)