1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
8 cMS$ATTRIBUTES C :: proc_proc
11 include 'COMMON.IOUNITS'
12 double precision energia(0:max_ene),energia1(0:max_ene+1)
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
23 double precision fact(5)
24 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
25 cd print *,'nnt=',nnt,' nct=',nct
27 C Compute the side-chain and electrostatic interaction energy
29 goto (101,102,103,104,105) ipot
30 C Lennard-Jones potential.
32 cd print '(a)','Exit ELJ'
34 C Lennard-Jones-Kihara potential (shifted).
37 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 C Gay-Berne potential (shifted LJ, angular dependence).
43 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 C Calculate electrostatic (H-bonding) energy of the main chain.
48 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
50 C Calculate excluded-volume interaction energy between peptide groups
53 call escp(evdw2,evdw2_14)
55 c Calculate the bond-stretching energy
58 c write (iout,*) "estr",estr
60 C Calculate the disulfide-bridge and other energy and the contributions
61 C from other distance constraints.
62 cd print *,'Calling EHPB'
64 cd print *,'EHPB exitted succesfully.'
66 C Calculate the virtual-bond-angle energy.
69 cd print *,'Bend energy finished.'
71 C Calculate the SC local energy.
74 cd print *,'SCLOC energy finished.'
76 C Calculate the virtual-bond torsional energy.
78 cd print *,'nterm=',nterm
79 call etor(etors,edihcnstr,fact(1))
81 C 6/23/01 Calculate double-torsional energy
83 call etor_d(etors_d,fact(2))
85 C 21/5/07 Calculate local sicdechain correlation energy
87 call eback_sc_corr(esccor,fact(1))
89 C 12/1/95 Multi-body terms
93 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
94 & .or. wturn6.gt.0.0d0) then
95 c print *,"calling multibody_eello"
96 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
97 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
98 c print *,ecorr,ecorr5,ecorr6,eturn6
100 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
101 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
103 C call multibody(ecorr)
108 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*ees+wvdwpp*evdw1
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*(ees+evdw1)
117 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
118 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
119 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
120 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
121 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
122 & +wbond*estr+wsccor*fact(1)*esccor
127 energia(2)=evdw2-evdw2_14
144 energia(8)=eello_turn3
145 energia(9)=eello_turn4
154 energia(20)=edihcnstr
155 cc if (dyn_ss) call dyn_set_nss
159 idumm=proc_proc(etot,i)
161 call proc_proc(etot,i)
163 if(i.eq.1)energia(0)=1.0d+99
169 C Sum up the components of the Cartesian gradient.
174 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
175 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
177 & wstrain*ghpbc(j,i)+
178 & wcorr*fact(3)*gradcorr(j,i)+
179 & wel_loc*fact(2)*gel_loc(j,i)+
180 & wturn3*fact(2)*gcorr3_turn(j,i)+
181 & wturn4*fact(3)*gcorr4_turn(j,i)+
182 & wcorr5*fact(4)*gradcorr5(j,i)+
183 & wcorr6*fact(5)*gradcorr6(j,i)+
184 & wturn6*fact(5)*gcorr6_turn(j,i)+
185 & wsccor*fact(2)*gsccorc(j,i)
186 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
188 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
193 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
194 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
196 & wcorr*fact(3)*gradcorr(j,i)+
197 & wel_loc*fact(2)*gel_loc(j,i)+
198 & wturn3*fact(2)*gcorr3_turn(j,i)+
199 & wturn4*fact(3)*gcorr4_turn(j,i)+
200 & wcorr5*fact(4)*gradcorr5(j,i)+
201 & wcorr6*fact(5)*gradcorr6(j,i)+
202 & wturn6*fact(5)*gcorr6_turn(j,i)+
203 & wsccor*fact(2)*gsccorc(j,i)
204 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
206 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
209 cd print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3),
210 cd & (gradc(k,i),k=1,3)
215 cd write (iout,*) i,g_corr5_loc(i)
216 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
217 & +wcorr5*fact(4)*g_corr5_loc(i)
218 & +wcorr6*fact(5)*g_corr6_loc(i)
219 & +wturn4*fact(3)*gel_loc_turn4(i)
220 & +wturn3*fact(2)*gel_loc_turn3(i)
221 & +wturn6*fact(5)*gel_loc_turn6(i)
222 & +wel_loc*fact(2)*gel_loc_loc(i)
223 & +wsccor*fact(1)*gsccor_loc(i)
226 cd call enerprint(energia(0),fact)
231 C------------------------------------------------------------------------
232 subroutine enerprint(energia,fact)
233 implicit real*8 (a-h,o-z)
235 include 'sizesclu.dat'
236 include 'COMMON.IOUNITS'
237 include 'COMMON.FFIELD'
238 include 'COMMON.SBRIDGE'
239 double precision energia(0:max_ene),fact(5)
243 evdw2=energia(2)+energia(17)
255 eello_turn3=energia(8)
256 eello_turn4=energia(9)
257 eello_turn6=energia(10)
264 edihcnstr=energia(20)
267 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
269 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
270 & etors_d,wtor_d*fact(2),ehpb,wstrain,
271 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
272 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
273 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
274 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
275 10 format (/'Virtual-chain energies:'//
276 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
277 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
278 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
279 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
280 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
281 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
282 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
283 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
284 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
285 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
286 & ' (SS bridges & dist. cnstr.)'/
287 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
288 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
289 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
290 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
291 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
292 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
293 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
294 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
295 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
296 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
297 & 'ETOT= ',1pE16.6,' (total)')
299 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
300 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
301 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
302 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
303 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
304 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
305 & edihcnstr,ebr*nss,etot
306 10 format (/'Virtual-chain energies:'//
307 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
308 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
309 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
310 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
311 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
312 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
313 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
314 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
315 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
316 & ' (SS bridges & dist. cnstr.)'/
317 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
318 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
319 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
320 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
321 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
322 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
323 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
324 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
325 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
326 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
327 & 'ETOT= ',1pE16.6,' (total)')
331 C-----------------------------------------------------------------------
334 C This subroutine calculates the interaction energy of nonbonded side chains
335 C assuming the LJ potential of interaction.
337 implicit real*8 (a-h,o-z)
339 include 'sizesclu.dat'
340 c include "DIMENSIONS.COMPAR"
341 parameter (accur=1.0d-10)
344 include 'COMMON.LOCAL'
345 include 'COMMON.CHAIN'
346 include 'COMMON.DERIV'
347 include 'COMMON.INTERACT'
348 include 'COMMON.TORSION'
349 include 'COMMON.SBRIDGE'
350 include 'COMMON.NAMES'
351 include 'COMMON.IOUNITS'
352 include 'COMMON.CONTACTS'
356 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
367 C Calculate SC interaction energy.
370 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
371 cd & 'iend=',iend(i,iint)
372 do j=istart(i,iint),iend(i,iint)
377 C Change 12/1/95 to calculate four-body interactions
378 rij=xj*xj+yj*yj+zj*zj
380 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
381 eps0ij=eps(itypi,itypj)
383 e1=fac*fac*aa(itypi,itypj)
384 e2=fac*bb(itypi,itypj)
386 ij=icant(itypi,itypj)
387 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
388 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
389 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
390 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
391 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
392 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
396 C Calculate the components of the gradient in DC and X
398 fac=-rrij*(e1+evdwij)
403 gvdwx(k,i)=gvdwx(k,i)-gg(k)
404 gvdwx(k,j)=gvdwx(k,j)+gg(k)
408 gvdwc(l,k)=gvdwc(l,k)+gg(l)
413 C 12/1/95, revised on 5/20/97
415 C Calculate the contact function. The ith column of the array JCONT will
416 C contain the numbers of atoms that make contacts with the atom I (of numbers
417 C greater than I). The arrays FACONT and GACONT will contain the values of
418 C the contact function and its derivative.
420 C Uncomment next line, if the correlation interactions include EVDW explicitly.
421 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
422 C Uncomment next line, if the correlation interactions are contact function only
423 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
425 sigij=sigma(itypi,itypj)
426 r0ij=rs0(itypi,itypj)
428 C Check whether the SC's are not too far to make a contact.
431 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
432 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
434 if (fcont.gt.0.0D0) then
435 C If the SC-SC distance if close to sigma, apply spline.
436 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
437 cAdam & fcont1,fprimcont1)
438 cAdam fcont1=1.0d0-fcont1
439 cAdam if (fcont1.gt.0.0d0) then
440 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
441 cAdam fcont=fcont*fcont1
443 C Uncomment following 4 lines to have the geometric average of the epsilon0's
444 cga eps0ij=1.0d0/dsqrt(eps0ij)
446 cga gg(k)=gg(k)*eps0ij
448 cga eps0ij=-evdwij*eps0ij
449 C Uncomment for AL's type of SC correlation interactions.
451 num_conti=num_conti+1
453 facont(num_conti,i)=fcont*eps0ij
454 fprimcont=eps0ij*fprimcont/rij
456 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
457 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
458 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
459 C Uncomment following 3 lines for Skolnick's type of SC correlation.
460 gacont(1,num_conti,i)=-fprimcont*xj
461 gacont(2,num_conti,i)=-fprimcont*yj
462 gacont(3,num_conti,i)=-fprimcont*zj
463 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
464 cd write (iout,'(2i3,3f10.5)')
465 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
471 num_cont(i)=num_conti
476 gvdwc(j,i)=expon*gvdwc(j,i)
477 gvdwx(j,i)=expon*gvdwx(j,i)
481 C******************************************************************************
485 C To save time, the factor of EXPON has been extracted from ALL components
486 C of GVDWC and GRADX. Remember to multiply them by this factor before further
489 C******************************************************************************
492 C-----------------------------------------------------------------------------
493 subroutine eljk(evdw)
495 C This subroutine calculates the interaction energy of nonbonded side chains
496 C assuming the LJK potential of interaction.
498 implicit real*8 (a-h,o-z)
500 include 'sizesclu.dat'
501 c include "DIMENSIONS.COMPAR"
504 include 'COMMON.LOCAL'
505 include 'COMMON.CHAIN'
506 include 'COMMON.DERIV'
507 include 'COMMON.INTERACT'
508 include 'COMMON.IOUNITS'
509 include 'COMMON.NAMES'
514 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
523 C Calculate SC interaction energy.
526 do j=istart(i,iint),iend(i,iint)
531 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
533 e_augm=augm(itypi,itypj)*fac_augm
536 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
537 fac=r_shift_inv**expon
538 e1=fac*fac*aa(itypi,itypj)
539 e2=fac*bb(itypi,itypj)
541 ij=icant(itypi,itypj)
542 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
543 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
544 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
545 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
546 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
547 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
548 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
552 C Calculate the components of the gradient in DC and X
554 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
559 gvdwx(k,i)=gvdwx(k,i)-gg(k)
560 gvdwx(k,j)=gvdwx(k,j)+gg(k)
564 gvdwc(l,k)=gvdwc(l,k)+gg(l)
574 gvdwc(j,i)=expon*gvdwc(j,i)
575 gvdwx(j,i)=expon*gvdwx(j,i)
581 C-----------------------------------------------------------------------------
584 C This subroutine calculates the interaction energy of nonbonded side chains
585 C assuming the Berne-Pechukas potential of interaction.
587 implicit real*8 (a-h,o-z)
589 include 'sizesclu.dat'
590 c include "DIMENSIONS.COMPAR"
593 include 'COMMON.LOCAL'
594 include 'COMMON.CHAIN'
595 include 'COMMON.DERIV'
596 include 'COMMON.NAMES'
597 include 'COMMON.INTERACT'
598 include 'COMMON.IOUNITS'
599 include 'COMMON.CALC'
601 c double precision rrsave(maxdim)
606 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
608 c if (icall.eq.0) then
620 dxi=dc_norm(1,nres+i)
621 dyi=dc_norm(2,nres+i)
622 dzi=dc_norm(3,nres+i)
623 dsci_inv=vbld_inv(i+nres)
625 C Calculate SC interaction energy.
628 do j=istart(i,iint),iend(i,iint)
631 dscj_inv=vbld_inv(j+nres)
632 chi1=chi(itypi,itypj)
633 chi2=chi(itypj,itypi)
640 alf12=0.5D0*(alf1+alf2)
641 C For diagnostics only!!!
654 dxj=dc_norm(1,nres+j)
655 dyj=dc_norm(2,nres+j)
656 dzj=dc_norm(3,nres+j)
657 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
658 cd if (icall.eq.0) then
664 C Calculate the angle-dependent terms of energy & contributions to derivatives.
666 C Calculate whole angle-dependent part of epsilon and contributions
668 fac=(rrij*sigsq)**expon2
669 e1=fac*fac*aa(itypi,itypj)
670 e2=fac*bb(itypi,itypj)
671 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
672 eps2der=evdwij*eps3rt
673 eps3der=evdwij*eps2rt
674 evdwij=evdwij*eps2rt*eps3rt
675 ij=icant(itypi,itypj)
676 aux=eps1*eps2rt**2*eps3rt**2
680 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
681 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
682 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
683 cd & restyp(itypi),i,restyp(itypj),j,
684 cd & epsi,sigm,chi1,chi2,chip1,chip2,
685 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
686 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
689 C Calculate gradient components.
690 e1=e1*eps1*eps2rt**2*eps3rt**2
691 fac=-expon*(e1+evdwij)
694 C Calculate radial part of the gradient
698 C Calculate the angular part of the gradient and sum add the contributions
699 C to the appropriate components of the Cartesian gradient.
708 C-----------------------------------------------------------------------------
711 C This subroutine calculates the interaction energy of nonbonded side chains
712 C assuming the Gay-Berne potential of interaction.
714 implicit real*8 (a-h,o-z)
716 include 'sizesclu.dat'
717 c include "DIMENSIONS.COMPAR"
720 include 'COMMON.LOCAL'
721 include 'COMMON.CHAIN'
722 include 'COMMON.DERIV'
723 include 'COMMON.NAMES'
724 include 'COMMON.INTERACT'
725 include 'COMMON.IOUNITS'
726 include 'COMMON.CALC'
727 include 'COMMON.SBRIDGE'
733 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
736 c if (icall.gt.0) lprn=.true.
744 dxi=dc_norm(1,nres+i)
745 dyi=dc_norm(2,nres+i)
746 dzi=dc_norm(3,nres+i)
747 dsci_inv=vbld_inv(i+nres)
749 C Calculate SC interaction energy.
752 do j=istart(i,iint),iend(i,iint)
753 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
754 call dyn_ssbond_ene(i,j,evdwij)
756 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
757 c & 'evdw',i,j,evdwij,' ss'
761 dscj_inv=vbld_inv(j+nres)
762 sig0ij=sigma(itypi,itypj)
763 chi1=chi(itypi,itypj)
764 chi2=chi(itypj,itypi)
771 alf12=0.5D0*(alf1+alf2)
772 C For diagnostics only!!!
785 dxj=dc_norm(1,nres+j)
786 dyj=dc_norm(2,nres+j)
787 dzj=dc_norm(3,nres+j)
788 c write (iout,*) i,j,xj,yj,zj
789 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
791 C Calculate angle-dependent terms of energy and contributions to their
795 sig=sig0ij*dsqrt(sigsq)
796 rij_shift=1.0D0/rij-sig+sig0ij
797 C I hate to put IF's in the loops, but here don't have another choice!!!!
798 if (rij_shift.le.0.0D0) then
803 c---------------------------------------------------------------
804 rij_shift=1.0D0/rij_shift
806 e1=fac*fac*aa(itypi,itypj)
807 e2=fac*bb(itypi,itypj)
808 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
809 eps2der=evdwij*eps3rt
810 eps3der=evdwij*eps2rt
811 evdwij=evdwij*eps2rt*eps3rt
813 ij=icant(itypi,itypj)
814 aux=eps1*eps2rt**2*eps3rt**2
815 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
816 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
817 c & aux*e2/eps(itypi,itypj)
819 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
820 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
821 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
822 & restyp(itypi),i,restyp(itypj),j,
823 & epsi,sigm,chi1,chi2,chip1,chip2,
824 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
825 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
829 C Calculate gradient components.
830 e1=e1*eps1*eps2rt**2*eps3rt**2
831 fac=-expon*(e1+evdwij)*rij_shift
834 C Calculate the radial part of the gradient
838 C Calculate angular part of the gradient.
847 C-----------------------------------------------------------------------------
848 subroutine egbv(evdw)
850 C This subroutine calculates the interaction energy of nonbonded side chains
851 C assuming the Gay-Berne-Vorobjev potential of interaction.
853 implicit real*8 (a-h,o-z)
855 include 'sizesclu.dat'
856 c include "DIMENSIONS.COMPAR"
859 include 'COMMON.LOCAL'
860 include 'COMMON.CHAIN'
861 include 'COMMON.DERIV'
862 include 'COMMON.NAMES'
863 include 'COMMON.INTERACT'
864 include 'COMMON.IOUNITS'
865 include 'COMMON.CALC'
866 include 'COMMON.SBRIDGE'
872 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
875 c if (icall.gt.0) lprn=.true.
883 dxi=dc_norm(1,nres+i)
884 dyi=dc_norm(2,nres+i)
885 dzi=dc_norm(3,nres+i)
886 dsci_inv=vbld_inv(i+nres)
888 C Calculate SC interaction energy.
891 do j=istart(i,iint),iend(i,iint)
892 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
893 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
894 call dyn_ssbond_ene(i,j,evdwij)
896 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
897 c & 'evdw',i,j,evdwij,' ss'
901 dscj_inv=vbld_inv(j+nres)
902 sig0ij=sigma(itypi,itypj)
904 chi1=chi(itypi,itypj)
905 chi2=chi(itypj,itypi)
912 alf12=0.5D0*(alf1+alf2)
913 C For diagnostics only!!!
926 dxj=dc_norm(1,nres+j)
927 dyj=dc_norm(2,nres+j)
928 dzj=dc_norm(3,nres+j)
929 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
931 C Calculate angle-dependent terms of energy and contributions to their
935 sig=sig0ij*dsqrt(sigsq)
936 rij_shift=1.0D0/rij-sig+r0ij
937 C I hate to put IF's in the loops, but here don't have another choice!!!!
938 if (rij_shift.le.0.0D0) then
943 c---------------------------------------------------------------
944 rij_shift=1.0D0/rij_shift
946 e1=fac*fac*aa(itypi,itypj)
947 e2=fac*bb(itypi,itypj)
948 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
949 eps2der=evdwij*eps3rt
950 eps3der=evdwij*eps2rt
952 e_augm=augm(itypi,itypj)*fac_augm
953 evdwij=evdwij*eps2rt*eps3rt
954 evdw=evdw+evdwij+e_augm
955 ij=icant(itypi,itypj)
956 aux=eps1*eps2rt**2*eps3rt**2
958 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
959 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
960 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
961 c & restyp(itypi),i,restyp(itypj),j,
962 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
963 c & chi1,chi2,chip1,chip2,
964 c & eps1,eps2rt**2,eps3rt**2,
965 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
969 C Calculate gradient components.
970 e1=e1*eps1*eps2rt**2*eps3rt**2
971 fac=-expon*(e1+evdwij)*rij_shift
973 fac=rij*fac-2*expon*rrij*e_augm
974 C Calculate the radial part of the gradient
978 C Calculate angular part of the gradient.
987 C-----------------------------------------------------------------------------
988 subroutine sc_angular
989 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
990 C om12. Called by ebp, egb, and egbv.
992 include 'COMMON.CALC'
996 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
997 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
998 om12=dxi*dxj+dyi*dyj+dzi*dzj
1000 C Calculate eps1(om12) and its derivative in om12
1001 faceps1=1.0D0-om12*chiom12
1002 faceps1_inv=1.0D0/faceps1
1003 eps1=dsqrt(faceps1_inv)
1004 C Following variable is eps1*deps1/dom12
1005 eps1_om12=faceps1_inv*chiom12
1006 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1011 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1012 sigsq=1.0D0-facsig*faceps1_inv
1013 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1014 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1015 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1016 C Calculate eps2 and its derivatives in om1, om2, and om12.
1019 chipom12=chip12*om12
1020 facp=1.0D0-om12*chipom12
1022 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1023 C Following variable is the square root of eps2
1024 eps2rt=1.0D0-facp1*facp_inv
1025 C Following three variables are the derivatives of the square root of eps
1026 C in om1, om2, and om12.
1027 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1028 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1029 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1030 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1031 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1032 C Calculate whole angle-dependent part of epsilon and contributions
1033 C to its derivatives
1036 C----------------------------------------------------------------------------
1038 implicit real*8 (a-h,o-z)
1039 include 'DIMENSIONS'
1040 include 'sizesclu.dat'
1041 include 'COMMON.CHAIN'
1042 include 'COMMON.DERIV'
1043 include 'COMMON.CALC'
1044 double precision dcosom1(3),dcosom2(3)
1045 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1046 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1047 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1048 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1050 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1051 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1054 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1057 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1058 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1059 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1060 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1061 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1062 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1065 C Calculate the components of the gradient in DC and X
1069 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1074 c------------------------------------------------------------------------------
1075 subroutine vec_and_deriv
1076 implicit real*8 (a-h,o-z)
1077 include 'DIMENSIONS'
1078 include 'sizesclu.dat'
1079 include 'COMMON.IOUNITS'
1080 include 'COMMON.GEO'
1081 include 'COMMON.VAR'
1082 include 'COMMON.LOCAL'
1083 include 'COMMON.CHAIN'
1084 include 'COMMON.VECTORS'
1085 include 'COMMON.DERIV'
1086 include 'COMMON.INTERACT'
1087 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1088 C Compute the local reference systems. For reference system (i), the
1089 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1090 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1092 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1093 if (i.eq.nres-1) then
1094 C Case of the last full residue
1095 C Compute the Z-axis
1096 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1097 costh=dcos(pi-theta(nres))
1098 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1103 C Compute the derivatives of uz
1105 uzder(2,1,1)=-dc_norm(3,i-1)
1106 uzder(3,1,1)= dc_norm(2,i-1)
1107 uzder(1,2,1)= dc_norm(3,i-1)
1109 uzder(3,2,1)=-dc_norm(1,i-1)
1110 uzder(1,3,1)=-dc_norm(2,i-1)
1111 uzder(2,3,1)= dc_norm(1,i-1)
1114 uzder(2,1,2)= dc_norm(3,i)
1115 uzder(3,1,2)=-dc_norm(2,i)
1116 uzder(1,2,2)=-dc_norm(3,i)
1118 uzder(3,2,2)= dc_norm(1,i)
1119 uzder(1,3,2)= dc_norm(2,i)
1120 uzder(2,3,2)=-dc_norm(1,i)
1123 C Compute the Y-axis
1126 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1129 C Compute the derivatives of uy
1132 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1133 & -dc_norm(k,i)*dc_norm(j,i-1)
1134 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1136 uyder(j,j,1)=uyder(j,j,1)-costh
1137 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1142 uygrad(l,k,j,i)=uyder(l,k,j)
1143 uzgrad(l,k,j,i)=uzder(l,k,j)
1147 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1148 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1149 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1150 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1154 C Compute the Z-axis
1155 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1156 costh=dcos(pi-theta(i+2))
1157 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1162 C Compute the derivatives of uz
1164 uzder(2,1,1)=-dc_norm(3,i+1)
1165 uzder(3,1,1)= dc_norm(2,i+1)
1166 uzder(1,2,1)= dc_norm(3,i+1)
1168 uzder(3,2,1)=-dc_norm(1,i+1)
1169 uzder(1,3,1)=-dc_norm(2,i+1)
1170 uzder(2,3,1)= dc_norm(1,i+1)
1173 uzder(2,1,2)= dc_norm(3,i)
1174 uzder(3,1,2)=-dc_norm(2,i)
1175 uzder(1,2,2)=-dc_norm(3,i)
1177 uzder(3,2,2)= dc_norm(1,i)
1178 uzder(1,3,2)= dc_norm(2,i)
1179 uzder(2,3,2)=-dc_norm(1,i)
1182 C Compute the Y-axis
1185 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1188 C Compute the derivatives of uy
1191 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1192 & -dc_norm(k,i)*dc_norm(j,i+1)
1193 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1195 uyder(j,j,1)=uyder(j,j,1)-costh
1196 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1201 uygrad(l,k,j,i)=uyder(l,k,j)
1202 uzgrad(l,k,j,i)=uzder(l,k,j)
1206 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1207 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1208 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1209 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1215 vbld_inv_temp(1)=vbld_inv(i+1)
1216 if (i.lt.nres-1) then
1217 vbld_inv_temp(2)=vbld_inv(i+2)
1219 vbld_inv_temp(2)=vbld_inv(i)
1224 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1225 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1233 C-----------------------------------------------------------------------------
1234 subroutine vec_and_deriv_test
1235 implicit real*8 (a-h,o-z)
1236 include 'DIMENSIONS'
1237 include 'sizesclu.dat'
1238 include 'COMMON.IOUNITS'
1239 include 'COMMON.GEO'
1240 include 'COMMON.VAR'
1241 include 'COMMON.LOCAL'
1242 include 'COMMON.CHAIN'
1243 include 'COMMON.VECTORS'
1244 dimension uyder(3,3,2),uzder(3,3,2)
1245 C Compute the local reference systems. For reference system (i), the
1246 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1247 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1249 if (i.eq.nres-1) then
1250 C Case of the last full residue
1251 C Compute the Z-axis
1252 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1253 costh=dcos(pi-theta(nres))
1254 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1255 c write (iout,*) 'fac',fac,
1256 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1257 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1261 C Compute the derivatives of uz
1263 uzder(2,1,1)=-dc_norm(3,i-1)
1264 uzder(3,1,1)= dc_norm(2,i-1)
1265 uzder(1,2,1)= dc_norm(3,i-1)
1267 uzder(3,2,1)=-dc_norm(1,i-1)
1268 uzder(1,3,1)=-dc_norm(2,i-1)
1269 uzder(2,3,1)= dc_norm(1,i-1)
1272 uzder(2,1,2)= dc_norm(3,i)
1273 uzder(3,1,2)=-dc_norm(2,i)
1274 uzder(1,2,2)=-dc_norm(3,i)
1276 uzder(3,2,2)= dc_norm(1,i)
1277 uzder(1,3,2)= dc_norm(2,i)
1278 uzder(2,3,2)=-dc_norm(1,i)
1280 C Compute the Y-axis
1282 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1285 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1286 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1287 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1289 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1292 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1293 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1296 c write (iout,*) 'facy',facy,
1297 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1298 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1300 uy(k,i)=facy*uy(k,i)
1302 C Compute the derivatives of uy
1305 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1306 & -dc_norm(k,i)*dc_norm(j,i-1)
1307 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1309 c uyder(j,j,1)=uyder(j,j,1)-costh
1310 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1311 uyder(j,j,1)=uyder(j,j,1)
1312 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1313 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1319 uygrad(l,k,j,i)=uyder(l,k,j)
1320 uzgrad(l,k,j,i)=uzder(l,k,j)
1324 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1325 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1326 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1327 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1330 C Compute the Z-axis
1331 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1332 costh=dcos(pi-theta(i+2))
1333 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1334 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1338 C Compute the derivatives of uz
1340 uzder(2,1,1)=-dc_norm(3,i+1)
1341 uzder(3,1,1)= dc_norm(2,i+1)
1342 uzder(1,2,1)= dc_norm(3,i+1)
1344 uzder(3,2,1)=-dc_norm(1,i+1)
1345 uzder(1,3,1)=-dc_norm(2,i+1)
1346 uzder(2,3,1)= dc_norm(1,i+1)
1349 uzder(2,1,2)= dc_norm(3,i)
1350 uzder(3,1,2)=-dc_norm(2,i)
1351 uzder(1,2,2)=-dc_norm(3,i)
1353 uzder(3,2,2)= dc_norm(1,i)
1354 uzder(1,3,2)= dc_norm(2,i)
1355 uzder(2,3,2)=-dc_norm(1,i)
1357 C Compute the Y-axis
1359 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1360 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1361 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1363 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1366 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1367 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1370 c write (iout,*) 'facy',facy,
1371 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1372 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1374 uy(k,i)=facy*uy(k,i)
1376 C Compute the derivatives of uy
1379 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1380 & -dc_norm(k,i)*dc_norm(j,i+1)
1381 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1383 c uyder(j,j,1)=uyder(j,j,1)-costh
1384 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1385 uyder(j,j,1)=uyder(j,j,1)
1386 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1387 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1393 uygrad(l,k,j,i)=uyder(l,k,j)
1394 uzgrad(l,k,j,i)=uzder(l,k,j)
1398 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1399 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1400 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1401 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1408 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1409 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1416 C-----------------------------------------------------------------------------
1417 subroutine check_vecgrad
1418 implicit real*8 (a-h,o-z)
1419 include 'DIMENSIONS'
1420 include 'sizesclu.dat'
1421 include 'COMMON.IOUNITS'
1422 include 'COMMON.GEO'
1423 include 'COMMON.VAR'
1424 include 'COMMON.LOCAL'
1425 include 'COMMON.CHAIN'
1426 include 'COMMON.VECTORS'
1427 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1428 dimension uyt(3,maxres),uzt(3,maxres)
1429 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1430 double precision delta /1.0d-7/
1433 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1434 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1435 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1436 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1437 cd & (dc_norm(if90,i),if90=1,3)
1438 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1439 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1440 cd write(iout,'(a)')
1446 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1447 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1460 cd write (iout,*) 'i=',i
1462 erij(k)=dc_norm(k,i)
1466 dc_norm(k,i)=erij(k)
1468 dc_norm(j,i)=dc_norm(j,i)+delta
1469 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1471 c dc_norm(k,i)=dc_norm(k,i)/fac
1473 c write (iout,*) (dc_norm(k,i),k=1,3)
1474 c write (iout,*) (erij(k),k=1,3)
1477 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1478 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1479 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1480 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1482 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1483 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1484 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1487 dc_norm(k,i)=erij(k)
1490 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1491 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1492 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1493 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1494 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1495 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1496 cd write (iout,'(a)')
1501 C--------------------------------------------------------------------------
1502 subroutine set_matrices
1503 implicit real*8 (a-h,o-z)
1504 include 'DIMENSIONS'
1505 include 'sizesclu.dat'
1506 include 'COMMON.IOUNITS'
1507 include 'COMMON.GEO'
1508 include 'COMMON.VAR'
1509 include 'COMMON.LOCAL'
1510 include 'COMMON.CHAIN'
1511 include 'COMMON.DERIV'
1512 include 'COMMON.INTERACT'
1513 include 'COMMON.CONTACTS'
1514 include 'COMMON.TORSION'
1515 include 'COMMON.VECTORS'
1516 include 'COMMON.FFIELD'
1517 double precision auxvec(2),auxmat(2,2)
1519 C Compute the virtual-bond-torsional-angle dependent quantities needed
1520 C to calculate the el-loc multibody terms of various order.
1523 if (i .lt. nres+1) then
1560 if (i .gt. 3 .and. i .lt. nres+1) then
1561 obrot_der(1,i-2)=-sin1
1562 obrot_der(2,i-2)= cos1
1563 Ugder(1,1,i-2)= sin1
1564 Ugder(1,2,i-2)=-cos1
1565 Ugder(2,1,i-2)=-cos1
1566 Ugder(2,2,i-2)=-sin1
1569 obrot2_der(1,i-2)=-dwasin2
1570 obrot2_der(2,i-2)= dwacos2
1571 Ug2der(1,1,i-2)= dwasin2
1572 Ug2der(1,2,i-2)=-dwacos2
1573 Ug2der(2,1,i-2)=-dwacos2
1574 Ug2der(2,2,i-2)=-dwasin2
1576 obrot_der(1,i-2)=0.0d0
1577 obrot_der(2,i-2)=0.0d0
1578 Ugder(1,1,i-2)=0.0d0
1579 Ugder(1,2,i-2)=0.0d0
1580 Ugder(2,1,i-2)=0.0d0
1581 Ugder(2,2,i-2)=0.0d0
1582 obrot2_der(1,i-2)=0.0d0
1583 obrot2_der(2,i-2)=0.0d0
1584 Ug2der(1,1,i-2)=0.0d0
1585 Ug2der(1,2,i-2)=0.0d0
1586 Ug2der(2,1,i-2)=0.0d0
1587 Ug2der(2,2,i-2)=0.0d0
1589 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1590 iti = itortyp(itype(i-2))
1594 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1595 iti1 = itortyp(itype(i-1))
1599 cd write (iout,*) '*******i',i,' iti1',iti
1600 cd write (iout,*) 'b1',b1(:,iti)
1601 cd write (iout,*) 'b2',b2(:,iti)
1602 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1603 if (i .gt. iatel_s+2) then
1604 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1605 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1606 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1607 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1608 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1609 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1610 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1620 DtUg2(l,k,i-2)=0.0d0
1624 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1625 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1626 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1627 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1628 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1629 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1630 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1632 muder(k,i-2)=Ub2der(k,i-2)
1634 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1635 iti1 = itortyp(itype(i-1))
1640 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1642 C Vectors and matrices dependent on a single virtual-bond dihedral.
1643 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1644 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1645 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1646 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1647 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1648 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1649 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1650 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1651 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1652 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1653 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1655 C Matrices dependent on two consecutive virtual-bond dihedrals.
1656 C The order of matrices is from left to right.
1658 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1659 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1660 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1661 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1662 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1663 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1664 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1665 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1668 cd iti = itortyp(itype(i))
1671 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1672 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1677 C--------------------------------------------------------------------------
1678 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1680 C This subroutine calculates the average interaction energy and its gradient
1681 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1682 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1683 C The potential depends both on the distance of peptide-group centers and on
1684 C the orientation of the CA-CA virtual bonds.
1686 implicit real*8 (a-h,o-z)
1687 include 'DIMENSIONS'
1688 include 'sizesclu.dat'
1689 include 'COMMON.CONTROL'
1690 include 'COMMON.IOUNITS'
1691 include 'COMMON.GEO'
1692 include 'COMMON.VAR'
1693 include 'COMMON.LOCAL'
1694 include 'COMMON.CHAIN'
1695 include 'COMMON.DERIV'
1696 include 'COMMON.INTERACT'
1697 include 'COMMON.CONTACTS'
1698 include 'COMMON.TORSION'
1699 include 'COMMON.VECTORS'
1700 include 'COMMON.FFIELD'
1701 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1702 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1703 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1704 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1705 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1706 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1707 double precision scal_el /0.5d0/
1709 C 13-go grudnia roku pamietnego...
1710 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1711 & 0.0d0,1.0d0,0.0d0,
1712 & 0.0d0,0.0d0,1.0d0/
1713 cd write(iout,*) 'In EELEC'
1715 cd write(iout,*) 'Type',i
1716 cd write(iout,*) 'B1',B1(:,i)
1717 cd write(iout,*) 'B2',B2(:,i)
1718 cd write(iout,*) 'CC',CC(:,:,i)
1719 cd write(iout,*) 'DD',DD(:,:,i)
1720 cd write(iout,*) 'EE',EE(:,:,i)
1722 cd call check_vecgrad
1724 if (icheckgrad.eq.1) then
1726 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1728 dc_norm(k,i)=dc(k,i)*fac
1730 c write (iout,*) 'i',i,' fac',fac
1733 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1734 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1735 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1736 cd if (wel_loc.gt.0.0d0) then
1737 if (icheckgrad.eq.1) then
1738 call vec_and_deriv_test
1745 cd write (iout,*) 'i=',i
1747 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1750 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1751 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1764 cd print '(a)','Enter EELEC'
1765 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1767 gel_loc_loc(i)=0.0d0
1770 do i=iatel_s,iatel_e
1771 if (itel(i).eq.0) goto 1215
1775 dx_normi=dc_norm(1,i)
1776 dy_normi=dc_norm(2,i)
1777 dz_normi=dc_norm(3,i)
1778 xmedi=c(1,i)+0.5d0*dxi
1779 ymedi=c(2,i)+0.5d0*dyi
1780 zmedi=c(3,i)+0.5d0*dzi
1782 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1783 do j=ielstart(i),ielend(i)
1784 if (itel(j).eq.0) goto 1216
1788 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1789 aaa=app(iteli,itelj)
1790 bbb=bpp(iteli,itelj)
1791 C Diagnostics only!!!
1797 ael6i=ael6(iteli,itelj)
1798 ael3i=ael3(iteli,itelj)
1802 dx_normj=dc_norm(1,j)
1803 dy_normj=dc_norm(2,j)
1804 dz_normj=dc_norm(3,j)
1805 xj=c(1,j)+0.5D0*dxj-xmedi
1806 yj=c(2,j)+0.5D0*dyj-ymedi
1807 zj=c(3,j)+0.5D0*dzj-zmedi
1808 rij=xj*xj+yj*yj+zj*zj
1814 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1815 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1816 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1817 fac=cosa-3.0D0*cosb*cosg
1819 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1820 if (j.eq.i+2) ev1=scal_el*ev1
1825 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1828 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1829 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1830 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1833 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1834 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1835 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1836 cd & xmedi,ymedi,zmedi,xj,yj,zj
1838 C Calculate contributions to the Cartesian gradient.
1841 facvdw=-6*rrmij*(ev1+evdwij)
1842 facel=-3*rrmij*(el1+eesij)
1849 * Radial derivatives. First process both termini of the fragment (i,j)
1856 gelc(k,i)=gelc(k,i)+ghalf
1857 gelc(k,j)=gelc(k,j)+ghalf
1860 * Loop over residues i+1 thru j-1.
1864 gelc(l,k)=gelc(l,k)+ggg(l)
1872 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1873 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1876 * Loop over residues i+1 thru j-1.
1880 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1887 fac=-3*rrmij*(facvdw+facvdw+facel)
1893 * Radial derivatives. First process both termini of the fragment (i,j)
1900 gelc(k,i)=gelc(k,i)+ghalf
1901 gelc(k,j)=gelc(k,j)+ghalf
1904 * Loop over residues i+1 thru j-1.
1908 gelc(l,k)=gelc(l,k)+ggg(l)
1915 ecosa=2.0D0*fac3*fac1+fac4
1918 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1919 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1921 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1922 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1924 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1925 cd & (dcosg(k),k=1,3)
1927 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1931 gelc(k,i)=gelc(k,i)+ghalf
1932 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1933 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1934 gelc(k,j)=gelc(k,j)+ghalf
1935 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1936 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1940 gelc(l,k)=gelc(l,k)+ggg(l)
1945 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1946 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
1947 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
1949 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
1950 C energy of a peptide unit is assumed in the form of a second-order
1951 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
1952 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
1953 C are computed for EVERY pair of non-contiguous peptide groups.
1955 if (j.lt.nres-1) then
1966 muij(kkk)=mu(k,i)*mu(l,j)
1969 cd write (iout,*) 'EELEC: i',i,' j',j
1970 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
1971 cd write(iout,*) 'muij',muij
1972 ury=scalar(uy(1,i),erij)
1973 urz=scalar(uz(1,i),erij)
1974 vry=scalar(uy(1,j),erij)
1975 vrz=scalar(uz(1,j),erij)
1976 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
1977 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
1978 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
1979 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
1980 C For diagnostics only
1985 fac=dsqrt(-ael6i)*r3ij
1986 cd write (2,*) 'fac=',fac
1987 C For diagnostics only
1993 cd write (iout,'(4i5,4f10.5)')
1994 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
1995 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
1996 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
1997 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
1998 cd write (iout,'(4f10.5)')
1999 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2000 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2001 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2002 cd write (iout,'(2i3,9f10.5/)') i,j,
2003 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2005 C Derivatives of the elements of A in virtual-bond vectors
2006 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2013 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2014 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2015 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2016 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2017 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2018 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2019 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2020 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2021 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2022 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2023 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2024 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2034 C Compute radial contributions to the gradient
2056 C Add the contributions coming from er
2059 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2060 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2061 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2062 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2065 C Derivatives in DC(i)
2066 ghalf1=0.5d0*agg(k,1)
2067 ghalf2=0.5d0*agg(k,2)
2068 ghalf3=0.5d0*agg(k,3)
2069 ghalf4=0.5d0*agg(k,4)
2070 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2071 & -3.0d0*uryg(k,2)*vry)+ghalf1
2072 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2073 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2074 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2075 & -3.0d0*urzg(k,2)*vry)+ghalf3
2076 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2077 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2078 C Derivatives in DC(i+1)
2079 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2080 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2081 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2082 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2083 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2084 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2085 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2086 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2087 C Derivatives in DC(j)
2088 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2089 & -3.0d0*vryg(k,2)*ury)+ghalf1
2090 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2091 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2092 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2093 & -3.0d0*vryg(k,2)*urz)+ghalf3
2094 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2095 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2096 C Derivatives in DC(j+1) or DC(nres-1)
2097 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2098 & -3.0d0*vryg(k,3)*ury)
2099 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2100 & -3.0d0*vrzg(k,3)*ury)
2101 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2102 & -3.0d0*vryg(k,3)*urz)
2103 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2104 & -3.0d0*vrzg(k,3)*urz)
2109 C Derivatives in DC(i+1)
2110 cd aggi1(k,1)=agg(k,1)
2111 cd aggi1(k,2)=agg(k,2)
2112 cd aggi1(k,3)=agg(k,3)
2113 cd aggi1(k,4)=agg(k,4)
2114 C Derivatives in DC(j)
2119 C Derivatives in DC(j+1)
2124 if (j.eq.nres-1 .and. i.lt.j-2) then
2126 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2127 cd aggj1(k,l)=agg(k,l)
2133 C Check the loc-el terms by numerical integration
2143 aggi(k,l)=-aggi(k,l)
2144 aggi1(k,l)=-aggi1(k,l)
2145 aggj(k,l)=-aggj(k,l)
2146 aggj1(k,l)=-aggj1(k,l)
2149 if (j.lt.nres-1) then
2155 aggi(k,l)=-aggi(k,l)
2156 aggi1(k,l)=-aggi1(k,l)
2157 aggj(k,l)=-aggj(k,l)
2158 aggj1(k,l)=-aggj1(k,l)
2169 aggi(k,l)=-aggi(k,l)
2170 aggi1(k,l)=-aggi1(k,l)
2171 aggj(k,l)=-aggj(k,l)
2172 aggj1(k,l)=-aggj1(k,l)
2178 IF (wel_loc.gt.0.0d0) THEN
2179 C Contribution to the local-electrostatic energy coming from the i-j pair
2180 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2182 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2183 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2184 eel_loc=eel_loc+eel_loc_ij
2185 C Partial derivatives in virtual-bond dihedral angles gamma
2188 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2189 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2190 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2191 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2192 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2193 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2194 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2195 cd write(iout,*) 'agg ',agg
2196 cd write(iout,*) 'aggi ',aggi
2197 cd write(iout,*) 'aggi1',aggi1
2198 cd write(iout,*) 'aggj ',aggj
2199 cd write(iout,*) 'aggj1',aggj1
2201 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2203 ggg(l)=agg(l,1)*muij(1)+
2204 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2208 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2211 C Remaining derivatives of eello
2213 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2214 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2215 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2216 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2217 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2218 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2219 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2220 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2224 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2225 C Contributions from turns
2230 call eturn34(i,j,eello_turn3,eello_turn4)
2232 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2233 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2235 C Calculate the contact function. The ith column of the array JCONT will
2236 C contain the numbers of atoms that make contacts with the atom I (of numbers
2237 C greater than I). The arrays FACONT and GACONT will contain the values of
2238 C the contact function and its derivative.
2239 c r0ij=1.02D0*rpp(iteli,itelj)
2240 c r0ij=1.11D0*rpp(iteli,itelj)
2241 r0ij=2.20D0*rpp(iteli,itelj)
2242 c r0ij=1.55D0*rpp(iteli,itelj)
2243 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2244 if (fcont.gt.0.0D0) then
2245 num_conti=num_conti+1
2246 if (num_conti.gt.maxconts) then
2247 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2248 & ' will skip next contacts for this conf.'
2250 jcont_hb(num_conti,i)=j
2251 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2252 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2253 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2255 d_cont(num_conti,i)=rij
2256 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2257 C --- Electrostatic-interaction matrix ---
2258 a_chuj(1,1,num_conti,i)=a22
2259 a_chuj(1,2,num_conti,i)=a23
2260 a_chuj(2,1,num_conti,i)=a32
2261 a_chuj(2,2,num_conti,i)=a33
2262 C --- Gradient of rij
2264 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2267 c a_chuj(1,1,num_conti,i)=-0.61d0
2268 c a_chuj(1,2,num_conti,i)= 0.4d0
2269 c a_chuj(2,1,num_conti,i)= 0.65d0
2270 c a_chuj(2,2,num_conti,i)= 0.50d0
2271 c else if (i.eq.2) then
2272 c a_chuj(1,1,num_conti,i)= 0.0d0
2273 c a_chuj(1,2,num_conti,i)= 0.0d0
2274 c a_chuj(2,1,num_conti,i)= 0.0d0
2275 c a_chuj(2,2,num_conti,i)= 0.0d0
2277 C --- and its gradients
2278 cd write (iout,*) 'i',i,' j',j
2280 cd write (iout,*) 'iii 1 kkk',kkk
2281 cd write (iout,*) agg(kkk,:)
2284 cd write (iout,*) 'iii 2 kkk',kkk
2285 cd write (iout,*) aggi(kkk,:)
2288 cd write (iout,*) 'iii 3 kkk',kkk
2289 cd write (iout,*) aggi1(kkk,:)
2292 cd write (iout,*) 'iii 4 kkk',kkk
2293 cd write (iout,*) aggj(kkk,:)
2296 cd write (iout,*) 'iii 5 kkk',kkk
2297 cd write (iout,*) aggj1(kkk,:)
2304 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2305 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2306 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2307 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2308 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2310 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2316 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2317 C Calculate contact energies
2319 wij=cosa-3.0D0*cosb*cosg
2322 c fac3=dsqrt(-ael6i)/r0ij**3
2323 fac3=dsqrt(-ael6i)*r3ij
2324 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2325 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2327 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2328 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2329 C Diagnostics. Comment out or remove after debugging!
2330 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2331 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2332 c ees0m(num_conti,i)=0.0D0
2334 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2335 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2336 facont_hb(num_conti,i)=fcont
2338 C Angular derivatives of the contact function
2339 ees0pij1=fac3/ees0pij
2340 ees0mij1=fac3/ees0mij
2341 fac3p=-3.0D0*fac3*rrmij
2342 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2343 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2345 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2346 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2347 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2348 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2349 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2350 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2351 ecosap=ecosa1+ecosa2
2352 ecosbp=ecosb1+ecosb2
2353 ecosgp=ecosg1+ecosg2
2354 ecosam=ecosa1-ecosa2
2355 ecosbm=ecosb1-ecosb2
2356 ecosgm=ecosg1-ecosg2
2365 fprimcont=fprimcont/rij
2366 cd facont_hb(num_conti,i)=1.0D0
2367 C Following line is for diagnostics.
2370 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2371 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2374 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2375 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2377 gggp(1)=gggp(1)+ees0pijp*xj
2378 gggp(2)=gggp(2)+ees0pijp*yj
2379 gggp(3)=gggp(3)+ees0pijp*zj
2380 gggm(1)=gggm(1)+ees0mijp*xj
2381 gggm(2)=gggm(2)+ees0mijp*yj
2382 gggm(3)=gggm(3)+ees0mijp*zj
2383 C Derivatives due to the contact function
2384 gacont_hbr(1,num_conti,i)=fprimcont*xj
2385 gacont_hbr(2,num_conti,i)=fprimcont*yj
2386 gacont_hbr(3,num_conti,i)=fprimcont*zj
2388 ghalfp=0.5D0*gggp(k)
2389 ghalfm=0.5D0*gggm(k)
2390 gacontp_hb1(k,num_conti,i)=ghalfp
2391 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2392 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2393 gacontp_hb2(k,num_conti,i)=ghalfp
2394 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2395 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2396 gacontp_hb3(k,num_conti,i)=gggp(k)
2397 gacontm_hb1(k,num_conti,i)=ghalfm
2398 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2399 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2400 gacontm_hb2(k,num_conti,i)=ghalfm
2401 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2402 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2403 gacontm_hb3(k,num_conti,i)=gggm(k)
2406 C Diagnostics. Comment out or remove after debugging!
2408 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2409 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2410 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2411 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2412 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2413 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2416 endif ! num_conti.le.maxconts
2421 num_cont_hb(i)=num_conti
2425 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2426 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2428 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2429 ccc eel_loc=eel_loc+eello_turn3
2432 C-----------------------------------------------------------------------------
2433 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2434 C Third- and fourth-order contributions from turns
2435 implicit real*8 (a-h,o-z)
2436 include 'DIMENSIONS'
2437 include 'sizesclu.dat'
2438 include 'COMMON.IOUNITS'
2439 include 'COMMON.GEO'
2440 include 'COMMON.VAR'
2441 include 'COMMON.LOCAL'
2442 include 'COMMON.CHAIN'
2443 include 'COMMON.DERIV'
2444 include 'COMMON.INTERACT'
2445 include 'COMMON.CONTACTS'
2446 include 'COMMON.TORSION'
2447 include 'COMMON.VECTORS'
2448 include 'COMMON.FFIELD'
2450 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2451 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2452 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2453 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2454 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2455 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2457 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2459 C Third-order contributions
2466 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2467 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2468 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2469 call transpose2(auxmat(1,1),auxmat1(1,1))
2470 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2471 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2472 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2473 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2474 cd & ' eello_turn3_num',4*eello_turn3_num
2476 C Derivatives in gamma(i)
2477 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2478 call transpose2(auxmat2(1,1),pizda(1,1))
2479 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2480 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2481 C Derivatives in gamma(i+1)
2482 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2483 call transpose2(auxmat2(1,1),pizda(1,1))
2484 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2485 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2486 & +0.5d0*(pizda(1,1)+pizda(2,2))
2487 C Cartesian derivatives
2489 a_temp(1,1)=aggi(l,1)
2490 a_temp(1,2)=aggi(l,2)
2491 a_temp(2,1)=aggi(l,3)
2492 a_temp(2,2)=aggi(l,4)
2493 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2494 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2495 & +0.5d0*(pizda(1,1)+pizda(2,2))
2496 a_temp(1,1)=aggi1(l,1)
2497 a_temp(1,2)=aggi1(l,2)
2498 a_temp(2,1)=aggi1(l,3)
2499 a_temp(2,2)=aggi1(l,4)
2500 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2501 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2502 & +0.5d0*(pizda(1,1)+pizda(2,2))
2503 a_temp(1,1)=aggj(l,1)
2504 a_temp(1,2)=aggj(l,2)
2505 a_temp(2,1)=aggj(l,3)
2506 a_temp(2,2)=aggj(l,4)
2507 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2508 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2509 & +0.5d0*(pizda(1,1)+pizda(2,2))
2510 a_temp(1,1)=aggj1(l,1)
2511 a_temp(1,2)=aggj1(l,2)
2512 a_temp(2,1)=aggj1(l,3)
2513 a_temp(2,2)=aggj1(l,4)
2514 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2515 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2516 & +0.5d0*(pizda(1,1)+pizda(2,2))
2519 else if (j.eq.i+3) then
2520 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2522 C Fourth-order contributions
2530 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2531 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2532 iti1=itortyp(itype(i+1))
2533 iti2=itortyp(itype(i+2))
2534 iti3=itortyp(itype(i+3))
2535 call transpose2(EUg(1,1,i+1),e1t(1,1))
2536 call transpose2(Eug(1,1,i+2),e2t(1,1))
2537 call transpose2(Eug(1,1,i+3),e3t(1,1))
2538 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2539 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2540 s1=scalar2(b1(1,iti2),auxvec(1))
2541 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2542 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2543 s2=scalar2(b1(1,iti1),auxvec(1))
2544 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2545 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2546 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2547 eello_turn4=eello_turn4-(s1+s2+s3)
2548 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2549 cd & ' eello_turn4_num',8*eello_turn4_num
2550 C Derivatives in gamma(i)
2552 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2553 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2554 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2555 s1=scalar2(b1(1,iti2),auxvec(1))
2556 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2557 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2558 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2559 C Derivatives in gamma(i+1)
2560 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2561 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2562 s2=scalar2(b1(1,iti1),auxvec(1))
2563 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2564 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2565 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2566 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2567 C Derivatives in gamma(i+2)
2568 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2569 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2570 s1=scalar2(b1(1,iti2),auxvec(1))
2571 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2572 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2573 s2=scalar2(b1(1,iti1),auxvec(1))
2574 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2575 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2576 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2577 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2578 C Cartesian derivatives
2579 C Derivatives of this turn contributions in DC(i+2)
2580 if (j.lt.nres-1) then
2582 a_temp(1,1)=agg(l,1)
2583 a_temp(1,2)=agg(l,2)
2584 a_temp(2,1)=agg(l,3)
2585 a_temp(2,2)=agg(l,4)
2586 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2587 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2588 s1=scalar2(b1(1,iti2),auxvec(1))
2589 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2590 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2591 s2=scalar2(b1(1,iti1),auxvec(1))
2592 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2593 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2594 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2596 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2599 C Remaining derivatives of this turn contribution
2601 a_temp(1,1)=aggi(l,1)
2602 a_temp(1,2)=aggi(l,2)
2603 a_temp(2,1)=aggi(l,3)
2604 a_temp(2,2)=aggi(l,4)
2605 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2606 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2607 s1=scalar2(b1(1,iti2),auxvec(1))
2608 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2609 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2610 s2=scalar2(b1(1,iti1),auxvec(1))
2611 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2612 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2613 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2614 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2615 a_temp(1,1)=aggi1(l,1)
2616 a_temp(1,2)=aggi1(l,2)
2617 a_temp(2,1)=aggi1(l,3)
2618 a_temp(2,2)=aggi1(l,4)
2619 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2620 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2621 s1=scalar2(b1(1,iti2),auxvec(1))
2622 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2623 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2624 s2=scalar2(b1(1,iti1),auxvec(1))
2625 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2626 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2627 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2628 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2629 a_temp(1,1)=aggj(l,1)
2630 a_temp(1,2)=aggj(l,2)
2631 a_temp(2,1)=aggj(l,3)
2632 a_temp(2,2)=aggj(l,4)
2633 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2634 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2635 s1=scalar2(b1(1,iti2),auxvec(1))
2636 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2637 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2638 s2=scalar2(b1(1,iti1),auxvec(1))
2639 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2640 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2641 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2642 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2643 a_temp(1,1)=aggj1(l,1)
2644 a_temp(1,2)=aggj1(l,2)
2645 a_temp(2,1)=aggj1(l,3)
2646 a_temp(2,2)=aggj1(l,4)
2647 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2648 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2649 s1=scalar2(b1(1,iti2),auxvec(1))
2650 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2651 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2652 s2=scalar2(b1(1,iti1),auxvec(1))
2653 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2654 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2655 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2656 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2662 C-----------------------------------------------------------------------------
2663 subroutine vecpr(u,v,w)
2664 implicit real*8(a-h,o-z)
2665 dimension u(3),v(3),w(3)
2666 w(1)=u(2)*v(3)-u(3)*v(2)
2667 w(2)=-u(1)*v(3)+u(3)*v(1)
2668 w(3)=u(1)*v(2)-u(2)*v(1)
2671 C-----------------------------------------------------------------------------
2672 subroutine unormderiv(u,ugrad,unorm,ungrad)
2673 C This subroutine computes the derivatives of a normalized vector u, given
2674 C the derivatives computed without normalization conditions, ugrad. Returns
2677 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2678 double precision vec(3)
2679 double precision scalar
2681 c write (2,*) 'ugrad',ugrad
2684 vec(i)=scalar(ugrad(1,i),u(1))
2686 c write (2,*) 'vec',vec
2689 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2692 c write (2,*) 'ungrad',ungrad
2695 C-----------------------------------------------------------------------------
2696 subroutine escp(evdw2,evdw2_14)
2698 C This subroutine calculates the excluded-volume interaction energy between
2699 C peptide-group centers and side chains and its gradient in virtual-bond and
2700 C side-chain vectors.
2702 implicit real*8 (a-h,o-z)
2703 include 'DIMENSIONS'
2704 include 'sizesclu.dat'
2705 include 'COMMON.GEO'
2706 include 'COMMON.VAR'
2707 include 'COMMON.LOCAL'
2708 include 'COMMON.CHAIN'
2709 include 'COMMON.DERIV'
2710 include 'COMMON.INTERACT'
2711 include 'COMMON.FFIELD'
2712 include 'COMMON.IOUNITS'
2716 cd print '(a)','Enter ESCP'
2717 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2718 c & ' scal14',scal14
2719 do i=iatscp_s,iatscp_e
2721 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2722 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2723 if (iteli.eq.0) goto 1225
2724 xi=0.5D0*(c(1,i)+c(1,i+1))
2725 yi=0.5D0*(c(2,i)+c(2,i+1))
2726 zi=0.5D0*(c(3,i)+c(3,i+1))
2728 do iint=1,nscp_gr(i)
2730 do j=iscpstart(i,iint),iscpend(i,iint)
2732 C Uncomment following three lines for SC-p interactions
2736 C Uncomment following three lines for Ca-p interactions
2740 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2742 e1=fac*fac*aad(itypj,iteli)
2743 e2=fac*bad(itypj,iteli)
2744 if (iabs(j-i) .le. 2) then
2747 evdw2_14=evdw2_14+e1+e2
2750 c write (iout,*) i,j,evdwij
2754 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2756 fac=-(evdwij+e1)*rrij
2761 cd write (iout,*) 'j<i'
2762 C Uncomment following three lines for SC-p interactions
2764 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2767 cd write (iout,*) 'j>i'
2770 C Uncomment following line for SC-p interactions
2771 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2775 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2779 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2780 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2783 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2793 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2794 gradx_scp(j,i)=expon*gradx_scp(j,i)
2797 C******************************************************************************
2801 C To save time the factor EXPON has been extracted from ALL components
2802 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2805 C******************************************************************************
2808 C--------------------------------------------------------------------------
2809 subroutine edis(ehpb)
2811 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2813 implicit real*8 (a-h,o-z)
2814 include 'DIMENSIONS'
2815 include 'COMMON.SBRIDGE'
2816 include 'COMMON.CHAIN'
2817 include 'COMMON.DERIV'
2818 include 'COMMON.VAR'
2819 include 'COMMON.INTERACT'
2820 include 'COMMON.IOUNITS'
2823 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2824 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2825 if (link_end.eq.0) return
2826 do i=link_start,link_end
2827 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2828 C CA-CA distance used in regularization of structure.
2831 C iii and jjj point to the residues for which the distance is assigned.
2832 if (ii.gt.nres) then
2839 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2840 c & dhpb(i),dhpb1(i),forcon(i)
2841 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2842 C distance and angle dependent SS bond potential.
2843 if (.not.dyn_ss .and. i.le.nss) then
2844 C 15/02/13 CC dynamic SSbond - additional check
2845 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2846 call ssbond_ene(iii,jjj,eij)
2848 cd write (iout,*) "eij",eij
2850 else if (ii.gt.nres .and. jj.gt.nres) then
2851 c Restraints from contact prediction
2853 if (dhpb1(i).gt.0.0d0) then
2854 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2855 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2856 c write (iout,*) "beta nmr",
2857 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2861 C Get the force constant corresponding to this distance.
2863 C Calculate the contribution to energy.
2864 ehpb=ehpb+waga*rdis*rdis
2865 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2867 C Evaluate gradient.
2872 ggg(j)=fac*(c(j,jj)-c(j,ii))
2875 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2876 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2879 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2880 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2883 C Calculate the distance between the two points and its difference from the
2886 if (dhpb1(i).gt.0.0d0) then
2887 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2888 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2889 c write (iout,*) "alph nmr",
2890 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2893 C Get the force constant corresponding to this distance.
2895 C Calculate the contribution to energy.
2896 ehpb=ehpb+waga*rdis*rdis
2897 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2899 C Evaluate gradient.
2903 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2904 cd & ' waga=',waga,' fac=',fac
2906 ggg(j)=fac*(c(j,jj)-c(j,ii))
2908 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2909 C If this is a SC-SC distance, we need to calculate the contributions to the
2910 C Cartesian gradient in the SC vectors (ghpbx).
2913 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2914 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2918 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2919 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2926 C--------------------------------------------------------------------------
2927 subroutine ssbond_ene(i,j,eij)
2929 C Calculate the distance and angle dependent SS-bond potential energy
2930 C using a free-energy function derived based on RHF/6-31G** ab initio
2931 C calculations of diethyl disulfide.
2933 C A. Liwo and U. Kozlowska, 11/24/03
2935 implicit real*8 (a-h,o-z)
2936 include 'DIMENSIONS'
2937 include 'sizesclu.dat'
2938 include 'COMMON.SBRIDGE'
2939 include 'COMMON.CHAIN'
2940 include 'COMMON.DERIV'
2941 include 'COMMON.LOCAL'
2942 include 'COMMON.INTERACT'
2943 include 'COMMON.VAR'
2944 include 'COMMON.IOUNITS'
2945 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2950 dxi=dc_norm(1,nres+i)
2951 dyi=dc_norm(2,nres+i)
2952 dzi=dc_norm(3,nres+i)
2953 dsci_inv=dsc_inv(itypi)
2955 dscj_inv=dsc_inv(itypj)
2959 dxj=dc_norm(1,nres+j)
2960 dyj=dc_norm(2,nres+j)
2961 dzj=dc_norm(3,nres+j)
2962 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2967 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2968 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2969 om12=dxi*dxj+dyi*dyj+dzi*dzj
2971 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2972 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2978 deltat12=om2-om1+2.0d0
2980 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2981 & +akct*deltad*deltat12+ebr
2982 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2983 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2984 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2985 c & " deltat12",deltat12," eij",eij
2986 ed=2*akcm*deltad+akct*deltat12
2988 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
2989 eom1=-2*akth*deltat1-pom1-om2*pom2
2990 eom2= 2*akth*deltat2+pom1-om1*pom2
2993 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2996 ghpbx(k,i)=ghpbx(k,i)-gg(k)
2997 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
2998 ghpbx(k,j)=ghpbx(k,j)+gg(k)
2999 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3002 C Calculate the components of the gradient in DC and X
3006 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3011 C--------------------------------------------------------------------------
3012 subroutine ebond(estr)
3014 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3016 implicit real*8 (a-h,o-z)
3017 include 'DIMENSIONS'
3018 include 'COMMON.LOCAL'
3019 include 'COMMON.GEO'
3020 include 'COMMON.INTERACT'
3021 include 'COMMON.DERIV'
3022 include 'COMMON.VAR'
3023 include 'COMMON.CHAIN'
3024 include 'COMMON.IOUNITS'
3025 include 'COMMON.NAMES'
3026 include 'COMMON.FFIELD'
3027 include 'COMMON.CONTROL'
3028 double precision u(3),ud(3)
3031 diff = vbld(i)-vbldp0
3032 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3035 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3040 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3047 diff=vbld(i+nres)-vbldsc0(1,iti)
3048 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3049 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3050 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3052 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3056 diff=vbld(i+nres)-vbldsc0(j,iti)
3057 ud(j)=aksc(j,iti)*diff
3058 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3072 uprod2=uprod2*u(k)*u(k)
3076 usumsqder=usumsqder+ud(j)*uprod2
3078 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3079 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3080 estr=estr+uprod/usum
3082 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3090 C--------------------------------------------------------------------------
3091 subroutine ebend(etheta)
3093 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3094 C angles gamma and its derivatives in consecutive thetas and gammas.
3096 implicit real*8 (a-h,o-z)
3097 include 'DIMENSIONS'
3098 include 'sizesclu.dat'
3099 include 'COMMON.LOCAL'
3100 include 'COMMON.GEO'
3101 include 'COMMON.INTERACT'
3102 include 'COMMON.DERIV'
3103 include 'COMMON.VAR'
3104 include 'COMMON.CHAIN'
3105 include 'COMMON.IOUNITS'
3106 include 'COMMON.NAMES'
3107 include 'COMMON.FFIELD'
3108 common /calcthet/ term1,term2,termm,diffak,ratak,
3109 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3110 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3111 double precision y(2),z(2)
3113 time11=dexp(-2*time)
3116 c write (iout,*) "nres",nres
3117 c write (*,'(a,i2)') 'EBEND ICG=',icg
3118 c write (iout,*) ithet_start,ithet_end
3119 do i=ithet_start,ithet_end
3120 C Zero the energy function and its derivative at 0 or pi.
3121 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3123 c if (i.gt.ithet_start .and.
3124 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3125 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3133 c if (i.lt.nres .and. itel(i).ne.0) then
3145 call proc_proc(phii,icrc)
3146 if (icrc.eq.1) phii=150.0
3160 call proc_proc(phii1,icrc)
3161 if (icrc.eq.1) phii1=150.0
3173 C Calculate the "mean" value of theta from the part of the distribution
3174 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3175 C In following comments this theta will be referred to as t_c.
3176 thet_pred_mean=0.0d0
3180 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3182 c write (iout,*) "thet_pred_mean",thet_pred_mean
3183 dthett=thet_pred_mean*ssd
3184 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3185 c write (iout,*) "thet_pred_mean",thet_pred_mean
3186 C Derivatives of the "mean" values in gamma1 and gamma2.
3187 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3188 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3189 if (theta(i).gt.pi-delta) then
3190 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3192 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3193 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3194 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3196 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3198 else if (theta(i).lt.delta) then
3199 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3200 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3201 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3203 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3204 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3207 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3210 etheta=etheta+ethetai
3211 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3212 c & rad2deg*phii,rad2deg*phii1,ethetai
3213 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3214 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3215 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3218 C Ufff.... We've done all this!!!
3221 C---------------------------------------------------------------------------
3222 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3224 implicit real*8 (a-h,o-z)
3225 include 'DIMENSIONS'
3226 include 'COMMON.LOCAL'
3227 include 'COMMON.IOUNITS'
3228 common /calcthet/ term1,term2,termm,diffak,ratak,
3229 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3230 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3231 C Calculate the contributions to both Gaussian lobes.
3232 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3233 C The "polynomial part" of the "standard deviation" of this part of
3237 sig=sig*thet_pred_mean+polthet(j,it)
3239 C Derivative of the "interior part" of the "standard deviation of the"
3240 C gamma-dependent Gaussian lobe in t_c.
3241 sigtc=3*polthet(3,it)
3243 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3246 C Set the parameters of both Gaussian lobes of the distribution.
3247 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3248 fac=sig*sig+sigc0(it)
3251 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3252 sigsqtc=-4.0D0*sigcsq*sigtc
3253 c print *,i,sig,sigtc,sigsqtc
3254 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3255 sigtc=-sigtc/(fac*fac)
3256 C Following variable is sigma(t_c)**(-2)
3257 sigcsq=sigcsq*sigcsq
3259 sig0inv=1.0D0/sig0i**2
3260 delthec=thetai-thet_pred_mean
3261 delthe0=thetai-theta0i
3262 term1=-0.5D0*sigcsq*delthec*delthec
3263 term2=-0.5D0*sig0inv*delthe0*delthe0
3264 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3265 C NaNs in taking the logarithm. We extract the largest exponent which is added
3266 C to the energy (this being the log of the distribution) at the end of energy
3267 C term evaluation for this virtual-bond angle.
3268 if (term1.gt.term2) then
3270 term2=dexp(term2-termm)
3274 term1=dexp(term1-termm)
3277 C The ratio between the gamma-independent and gamma-dependent lobes of
3278 C the distribution is a Gaussian function of thet_pred_mean too.
3279 diffak=gthet(2,it)-thet_pred_mean
3280 ratak=diffak/gthet(3,it)**2
3281 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3282 C Let's differentiate it in thet_pred_mean NOW.
3284 C Now put together the distribution terms to make complete distribution.
3285 termexp=term1+ak*term2
3286 termpre=sigc+ak*sig0i
3287 C Contribution of the bending energy from this theta is just the -log of
3288 C the sum of the contributions from the two lobes and the pre-exponential
3289 C factor. Simple enough, isn't it?
3290 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3291 C NOW the derivatives!!!
3292 C 6/6/97 Take into account the deformation.
3293 E_theta=(delthec*sigcsq*term1
3294 & +ak*delthe0*sig0inv*term2)/termexp
3295 E_tc=((sigtc+aktc*sig0i)/termpre
3296 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3297 & aktc*term2)/termexp)
3300 c-----------------------------------------------------------------------------
3301 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3302 implicit real*8 (a-h,o-z)
3303 include 'DIMENSIONS'
3304 include 'COMMON.LOCAL'
3305 include 'COMMON.IOUNITS'
3306 common /calcthet/ term1,term2,termm,diffak,ratak,
3307 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3308 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3309 delthec=thetai-thet_pred_mean
3310 delthe0=thetai-theta0i
3311 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3312 t3 = thetai-thet_pred_mean
3316 t14 = t12+t6*sigsqtc
3318 t21 = thetai-theta0i
3324 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3325 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3326 & *(-t12*t9-ak*sig0inv*t27)
3330 C--------------------------------------------------------------------------
3331 subroutine ebend(etheta)
3333 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3334 C angles gamma and its derivatives in consecutive thetas and gammas.
3335 C ab initio-derived potentials from
3336 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3338 implicit real*8 (a-h,o-z)
3339 include 'DIMENSIONS'
3340 include 'COMMON.LOCAL'
3341 include 'COMMON.GEO'
3342 include 'COMMON.INTERACT'
3343 include 'COMMON.DERIV'
3344 include 'COMMON.VAR'
3345 include 'COMMON.CHAIN'
3346 include 'COMMON.IOUNITS'
3347 include 'COMMON.NAMES'
3348 include 'COMMON.FFIELD'
3349 include 'COMMON.CONTROL'
3350 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3351 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3352 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3353 & sinph1ph2(maxdouble,maxdouble)
3354 logical lprn /.false./, lprn1 /.false./
3356 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3357 do i=ithet_start,ithet_end
3358 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3359 &(itype(i).eq.ntyp1)) cycle
3363 theti2=0.5d0*theta(i)
3364 ityp2=ithetyp(itype(i-1))
3366 coskt(k)=dcos(k*theti2)
3367 sinkt(k)=dsin(k*theti2)
3369 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
3372 if (phii.ne.phii) phii=150.0
3376 ityp1=ithetyp(itype(i-2))
3378 cosph1(k)=dcos(k*phii)
3379 sinph1(k)=dsin(k*phii)
3383 ityp1=ithetyp(itype(i-2))
3389 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3392 if (phii1.ne.phii1) phii1=150.0
3397 ityp3=ithetyp(itype(i))
3399 cosph2(k)=dcos(k*phii1)
3400 sinph2(k)=dsin(k*phii1)
3404 ityp3=ithetyp(itype(i))
3410 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3411 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3413 ethetai=aa0thet(ityp1,ityp2,ityp3)
3416 ccl=cosph1(l)*cosph2(k-l)
3417 ssl=sinph1(l)*sinph2(k-l)
3418 scl=sinph1(l)*cosph2(k-l)
3419 csl=cosph1(l)*sinph2(k-l)
3420 cosph1ph2(l,k)=ccl-ssl
3421 cosph1ph2(k,l)=ccl+ssl
3422 sinph1ph2(l,k)=scl+csl
3423 sinph1ph2(k,l)=scl-csl
3427 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3428 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3429 write (iout,*) "coskt and sinkt"
3431 write (iout,*) k,coskt(k),sinkt(k)
3435 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3436 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3439 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3440 & " ethetai",ethetai
3443 write (iout,*) "cosph and sinph"
3445 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3447 write (iout,*) "cosph1ph2 and sinph2ph2"
3450 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3451 & sinph1ph2(l,k),sinph1ph2(k,l)
3454 write(iout,*) "ethetai",ethetai
3458 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3459 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3460 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3461 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3462 ethetai=ethetai+sinkt(m)*aux
3463 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3464 dephii=dephii+k*sinkt(m)*(
3465 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3466 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3467 dephii1=dephii1+k*sinkt(m)*(
3468 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3469 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3471 & write (iout,*) "m",m," k",k," bbthet",
3472 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3473 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3474 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3475 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3479 & write(iout,*) "ethetai",ethetai
3483 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3484 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3485 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3486 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3487 ethetai=ethetai+sinkt(m)*aux
3488 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3489 dephii=dephii+l*sinkt(m)*(
3490 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3491 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3492 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3493 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3494 dephii1=dephii1+(k-l)*sinkt(m)*(
3495 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3496 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3497 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3498 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3500 write (iout,*) "m",m," k",k," l",l," ffthet",
3501 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3502 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3503 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3504 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3505 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3506 & cosph1ph2(k,l)*sinkt(m),
3507 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3513 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3514 & i,theta(i)*rad2deg,phii*rad2deg,
3515 & phii1*rad2deg,ethetai
3516 etheta=etheta+ethetai
3517 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3518 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3519 gloc(nphi+i-2,icg)=wang*dethetai
3525 c-----------------------------------------------------------------------------
3526 subroutine esc(escloc)
3527 C Calculate the local energy of a side chain and its derivatives in the
3528 C corresponding virtual-bond valence angles THETA and the spherical angles
3530 implicit real*8 (a-h,o-z)
3531 include 'DIMENSIONS'
3532 include 'sizesclu.dat'
3533 include 'COMMON.GEO'
3534 include 'COMMON.LOCAL'
3535 include 'COMMON.VAR'
3536 include 'COMMON.INTERACT'
3537 include 'COMMON.DERIV'
3538 include 'COMMON.CHAIN'
3539 include 'COMMON.IOUNITS'
3540 include 'COMMON.NAMES'
3541 include 'COMMON.FFIELD'
3542 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3543 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3544 common /sccalc/ time11,time12,time112,theti,it,nlobit
3547 c write (iout,'(a)') 'ESC'
3548 do i=loc_start,loc_end
3550 if (it.eq.10) goto 1
3552 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3553 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3554 theti=theta(i+1)-pipol
3558 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3560 if (x(2).gt.pi-delta) then
3564 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3566 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3567 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3569 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3570 & ddersc0(1),dersc(1))
3571 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3572 & ddersc0(3),dersc(3))
3574 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3576 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3577 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3578 & dersc0(2),esclocbi,dersc02)
3579 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3581 call splinthet(x(2),0.5d0*delta,ss,ssd)
3586 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3588 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3589 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3591 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3593 c write (iout,*) escloci
3594 else if (x(2).lt.delta) then
3598 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3600 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3601 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3603 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3604 & ddersc0(1),dersc(1))
3605 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3606 & ddersc0(3),dersc(3))
3608 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3610 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3611 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3612 & dersc0(2),esclocbi,dersc02)
3613 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3618 call splinthet(x(2),0.5d0*delta,ss,ssd)
3620 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3622 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3623 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3625 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3626 c write (iout,*) escloci
3628 call enesc(x,escloci,dersc,ddummy,.false.)
3631 escloc=escloc+escloci
3632 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3634 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3636 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3637 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3642 C---------------------------------------------------------------------------
3643 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3644 implicit real*8 (a-h,o-z)
3645 include 'DIMENSIONS'
3646 include 'COMMON.GEO'
3647 include 'COMMON.LOCAL'
3648 include 'COMMON.IOUNITS'
3649 common /sccalc/ time11,time12,time112,theti,it,nlobit
3650 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3651 double precision contr(maxlob,-1:1)
3653 c write (iout,*) 'it=',it,' nlobit=',nlobit
3657 if (mixed) ddersc(j)=0.0d0
3661 C Because of periodicity of the dependence of the SC energy in omega we have
3662 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3663 C To avoid underflows, first compute & store the exponents.
3671 z(k)=x(k)-censc(k,j,it)
3676 Axk=Axk+gaussc(l,k,j,it)*z(l)
3682 expfac=expfac+Ax(k,j,iii)*z(k)
3690 C As in the case of ebend, we want to avoid underflows in exponentiation and
3691 C subsequent NaNs and INFs in energy calculation.
3692 C Find the largest exponent
3696 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3700 cd print *,'it=',it,' emin=',emin
3702 C Compute the contribution to SC energy and derivatives
3706 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3707 cd print *,'j=',j,' expfac=',expfac
3708 escloc_i=escloc_i+expfac
3710 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3714 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3715 & +gaussc(k,2,j,it))*expfac
3722 dersc(1)=dersc(1)/cos(theti)**2
3723 ddersc(1)=ddersc(1)/cos(theti)**2
3726 escloci=-(dlog(escloc_i)-emin)
3728 dersc(j)=dersc(j)/escloc_i
3732 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3737 C------------------------------------------------------------------------------
3738 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3739 implicit real*8 (a-h,o-z)
3740 include 'DIMENSIONS'
3741 include 'COMMON.GEO'
3742 include 'COMMON.LOCAL'
3743 include 'COMMON.IOUNITS'
3744 common /sccalc/ time11,time12,time112,theti,it,nlobit
3745 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3746 double precision contr(maxlob)
3757 z(k)=x(k)-censc(k,j,it)
3763 Axk=Axk+gaussc(l,k,j,it)*z(l)
3769 expfac=expfac+Ax(k,j)*z(k)
3774 C As in the case of ebend, we want to avoid underflows in exponentiation and
3775 C subsequent NaNs and INFs in energy calculation.
3776 C Find the largest exponent
3779 if (emin.gt.contr(j)) emin=contr(j)
3783 C Compute the contribution to SC energy and derivatives
3787 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3788 escloc_i=escloc_i+expfac
3790 dersc(k)=dersc(k)+Ax(k,j)*expfac
3792 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3793 & +gaussc(1,2,j,it))*expfac
3797 dersc(1)=dersc(1)/cos(theti)**2
3798 dersc12=dersc12/cos(theti)**2
3799 escloci=-(dlog(escloc_i)-emin)
3801 dersc(j)=dersc(j)/escloc_i
3803 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3807 c----------------------------------------------------------------------------------
3808 subroutine esc(escloc)
3809 C Calculate the local energy of a side chain and its derivatives in the
3810 C corresponding virtual-bond valence angles THETA and the spherical angles
3811 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3812 C added by Urszula Kozlowska. 07/11/2007
3814 implicit real*8 (a-h,o-z)
3815 include 'DIMENSIONS'
3816 include 'COMMON.GEO'
3817 include 'COMMON.LOCAL'
3818 include 'COMMON.VAR'
3819 include 'COMMON.SCROT'
3820 include 'COMMON.INTERACT'
3821 include 'COMMON.DERIV'
3822 include 'COMMON.CHAIN'
3823 include 'COMMON.IOUNITS'
3824 include 'COMMON.NAMES'
3825 include 'COMMON.FFIELD'
3826 include 'COMMON.CONTROL'
3827 include 'COMMON.VECTORS'
3828 double precision x_prime(3),y_prime(3),z_prime(3)
3829 & , sumene,dsc_i,dp2_i,x(65),
3830 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3831 & de_dxx,de_dyy,de_dzz,de_dt
3832 double precision s1_t,s1_6_t,s2_t,s2_6_t
3834 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3835 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3836 & dt_dCi(3),dt_dCi1(3)
3837 common /sccalc/ time11,time12,time112,theti,it,nlobit
3840 do i=loc_start,loc_end
3841 costtab(i+1) =dcos(theta(i+1))
3842 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3843 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3844 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3845 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3846 cosfac=dsqrt(cosfac2)
3847 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3848 sinfac=dsqrt(sinfac2)
3850 if (it.eq.10) goto 1
3852 C Compute the axes of tghe local cartesian coordinates system; store in
3853 c x_prime, y_prime and z_prime
3860 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3861 C & dc_norm(3,i+nres)
3863 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3864 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3867 z_prime(j) = -uz(j,i-1)
3870 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3871 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3872 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3873 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3874 c & " xy",scalar(x_prime(1),y_prime(1)),
3875 c & " xz",scalar(x_prime(1),z_prime(1)),
3876 c & " yy",scalar(y_prime(1),y_prime(1)),
3877 c & " yz",scalar(y_prime(1),z_prime(1)),
3878 c & " zz",scalar(z_prime(1),z_prime(1))
3880 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3881 C to local coordinate system. Store in xx, yy, zz.
3887 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3888 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3889 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3896 C Compute the energy of the ith side cbain
3898 c write (2,*) "xx",xx," yy",yy," zz",zz
3901 x(j) = sc_parmin(j,it)
3904 Cc diagnostics - remove later
3906 yy1 = dsin(alph(2))*dcos(omeg(2))
3907 zz1 = -dsin(alph(2))*dsin(omeg(2))
3908 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3909 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3911 C," --- ", xx_w,yy_w,zz_w
3914 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3915 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3917 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3918 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3920 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3921 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3922 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3923 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3924 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3926 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3927 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3928 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3929 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3930 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3932 dsc_i = 0.743d0+x(61)
3934 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3935 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3936 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3937 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3938 s1=(1+x(63))/(0.1d0 + dscp1)
3939 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3940 s2=(1+x(65))/(0.1d0 + dscp2)
3941 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3942 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3943 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3944 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3946 c & dscp1,dscp2,sumene
3947 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3948 escloc = escloc + sumene
3949 c write (2,*) "escloc",escloc
3950 if (.not. calc_grad) goto 1
3953 C This section to check the numerical derivatives of the energy of ith side
3954 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3955 C #define DEBUG in the code to turn it on.
3957 write (2,*) "sumene =",sumene
3961 write (2,*) xx,yy,zz
3962 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3963 de_dxx_num=(sumenep-sumene)/aincr
3965 write (2,*) "xx+ sumene from enesc=",sumenep
3968 write (2,*) xx,yy,zz
3969 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3970 de_dyy_num=(sumenep-sumene)/aincr
3972 write (2,*) "yy+ sumene from enesc=",sumenep
3975 write (2,*) xx,yy,zz
3976 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3977 de_dzz_num=(sumenep-sumene)/aincr
3979 write (2,*) "zz+ sumene from enesc=",sumenep
3980 costsave=cost2tab(i+1)
3981 sintsave=sint2tab(i+1)
3982 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
3983 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
3984 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3985 de_dt_num=(sumenep-sumene)/aincr
3986 write (2,*) " t+ sumene from enesc=",sumenep
3987 cost2tab(i+1)=costsave
3988 sint2tab(i+1)=sintsave
3989 C End of diagnostics section.
3992 C Compute the gradient of esc
3994 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
3995 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
3996 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
3997 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
3998 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
3999 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4000 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4001 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4002 pom1=(sumene3*sint2tab(i+1)+sumene1)
4003 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4004 pom2=(sumene4*cost2tab(i+1)+sumene2)
4005 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4006 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4007 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4008 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4010 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4011 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4012 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4014 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4015 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4016 & +(pom1+pom2)*pom_dx
4018 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4021 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4022 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4023 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4025 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4026 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4027 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4028 & +x(59)*zz**2 +x(60)*xx*zz
4029 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4030 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4031 & +(pom1-pom2)*pom_dy
4033 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4036 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4037 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4038 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4039 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4040 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4041 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4042 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4043 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4045 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4048 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4049 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4050 & +pom1*pom_dt1+pom2*pom_dt2
4052 write(2,*), "de_dt = ", de_dt,de_dt_num
4056 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4057 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4058 cosfac2xx=cosfac2*xx
4059 sinfac2yy=sinfac2*yy
4061 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4063 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4065 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4066 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4067 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4068 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4069 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4070 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4071 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4072 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4073 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4074 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4078 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4079 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4082 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4083 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4084 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4086 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4087 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4091 dXX_Ctab(k,i)=dXX_Ci(k)
4092 dXX_C1tab(k,i)=dXX_Ci1(k)
4093 dYY_Ctab(k,i)=dYY_Ci(k)
4094 dYY_C1tab(k,i)=dYY_Ci1(k)
4095 dZZ_Ctab(k,i)=dZZ_Ci(k)
4096 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4097 dXX_XYZtab(k,i)=dXX_XYZ(k)
4098 dYY_XYZtab(k,i)=dYY_XYZ(k)
4099 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4103 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4104 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4105 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4106 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4107 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4109 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4110 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4111 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4112 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4113 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4114 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4115 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4116 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4118 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4119 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4121 C to check gradient call subroutine check_grad
4128 c------------------------------------------------------------------------------
4129 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4131 C This procedure calculates two-body contact function g(rij) and its derivative:
4134 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4137 C where x=(rij-r0ij)/delta
4139 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4142 double precision rij,r0ij,eps0ij,fcont,fprimcont
4143 double precision x,x2,x4,delta
4147 if (x.lt.-1.0D0) then
4150 else if (x.le.1.0D0) then
4153 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4154 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4161 c------------------------------------------------------------------------------
4162 subroutine splinthet(theti,delta,ss,ssder)
4163 implicit real*8 (a-h,o-z)
4164 include 'DIMENSIONS'
4165 include 'sizesclu.dat'
4166 include 'COMMON.VAR'
4167 include 'COMMON.GEO'
4170 if (theti.gt.pipol) then
4171 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4173 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4178 c------------------------------------------------------------------------------
4179 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4181 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4182 double precision ksi,ksi2,ksi3,a1,a2,a3
4183 a1=fprim0*delta/(f1-f0)
4189 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4190 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4193 c------------------------------------------------------------------------------
4194 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4196 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4197 double precision ksi,ksi2,ksi3,a1,a2,a3
4202 a2=3*(f1x-f0x)-2*fprim0x*delta
4203 a3=fprim0x*delta-2*(f1x-f0x)
4204 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4207 C-----------------------------------------------------------------------------
4209 C-----------------------------------------------------------------------------
4210 subroutine etor(etors,edihcnstr,fact)
4211 implicit real*8 (a-h,o-z)
4212 include 'DIMENSIONS'
4213 include 'sizesclu.dat'
4214 include 'COMMON.VAR'
4215 include 'COMMON.GEO'
4216 include 'COMMON.LOCAL'
4217 include 'COMMON.TORSION'
4218 include 'COMMON.INTERACT'
4219 include 'COMMON.DERIV'
4220 include 'COMMON.CHAIN'
4221 include 'COMMON.NAMES'
4222 include 'COMMON.IOUNITS'
4223 include 'COMMON.FFIELD'
4224 include 'COMMON.TORCNSTR'
4226 C Set lprn=.true. for debugging
4230 do i=iphi_start,iphi_end
4231 itori=itortyp(itype(i-2))
4232 itori1=itortyp(itype(i-1))
4235 C Proline-Proline pair is a special case...
4236 if (itori.eq.3 .and. itori1.eq.3) then
4237 if (phii.gt.-dwapi3) then
4239 fac=1.0D0/(1.0D0-cosphi)
4240 etorsi=v1(1,3,3)*fac
4241 etorsi=etorsi+etorsi
4242 etors=etors+etorsi-v1(1,3,3)
4243 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4246 v1ij=v1(j+1,itori,itori1)
4247 v2ij=v2(j+1,itori,itori1)
4250 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4251 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4255 v1ij=v1(j,itori,itori1)
4256 v2ij=v2(j,itori,itori1)
4259 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4260 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4264 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4265 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4266 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4267 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4268 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4270 ! 6/20/98 - dihedral angle constraints
4273 itori=idih_constr(i)
4275 difi=pinorm(phii-phi0(i))
4276 if (difi.gt.drange(i)) then
4278 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4279 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4280 else if (difi.lt.-drange(i)) then
4282 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4283 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4285 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4286 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4288 write (iout,*) 'edihcnstr',edihcnstr
4291 c------------------------------------------------------------------------------
4293 subroutine etor(etors,edihcnstr,fact)
4294 implicit real*8 (a-h,o-z)
4295 include 'DIMENSIONS'
4296 include 'sizesclu.dat'
4297 include 'COMMON.VAR'
4298 include 'COMMON.GEO'
4299 include 'COMMON.LOCAL'
4300 include 'COMMON.TORSION'
4301 include 'COMMON.INTERACT'
4302 include 'COMMON.DERIV'
4303 include 'COMMON.CHAIN'
4304 include 'COMMON.NAMES'
4305 include 'COMMON.IOUNITS'
4306 include 'COMMON.FFIELD'
4307 include 'COMMON.TORCNSTR'
4309 C Set lprn=.true. for debugging
4313 do i=iphi_start,iphi_end
4314 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4315 itori=itortyp(itype(i-2))
4316 itori1=itortyp(itype(i-1))
4319 C Regular cosine and sine terms
4320 do j=1,nterm(itori,itori1)
4321 v1ij=v1(j,itori,itori1)
4322 v2ij=v2(j,itori,itori1)
4325 etors=etors+v1ij*cosphi+v2ij*sinphi
4326 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4330 C E = SUM ----------------------------------- - v1
4331 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4333 cosphi=dcos(0.5d0*phii)
4334 sinphi=dsin(0.5d0*phii)
4335 do j=1,nlor(itori,itori1)
4336 vl1ij=vlor1(j,itori,itori1)
4337 vl2ij=vlor2(j,itori,itori1)
4338 vl3ij=vlor3(j,itori,itori1)
4339 pom=vl2ij*cosphi+vl3ij*sinphi
4340 pom1=1.0d0/(pom*pom+1.0d0)
4341 etors=etors+vl1ij*pom1
4343 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4345 C Subtract the constant term
4346 etors=etors-v0(itori,itori1)
4348 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4349 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4350 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4351 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4352 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4355 ! 6/20/98 - dihedral angle constraints
4357 c write (iout,*) "Dihedral angle restraint energy"
4359 itori=idih_constr(i)
4361 difi=pinorm(phii-phi0(i))
4362 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
4363 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
4364 if (difi.gt.drange(i)) then
4366 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4367 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4368 c write (iout,*) 0.25d0*ftors*difi**4
4369 else if (difi.lt.-drange(i)) then
4371 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4372 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4373 c write (iout,*) 0.25d0*ftors*difi**4
4376 c write (iout,*) 'edihcnstr',edihcnstr
4379 c----------------------------------------------------------------------------
4380 subroutine etor_d(etors_d,fact2)
4381 C 6/23/01 Compute double torsional energy
4382 implicit real*8 (a-h,o-z)
4383 include 'DIMENSIONS'
4384 include 'sizesclu.dat'
4385 include 'COMMON.VAR'
4386 include 'COMMON.GEO'
4387 include 'COMMON.LOCAL'
4388 include 'COMMON.TORSION'
4389 include 'COMMON.INTERACT'
4390 include 'COMMON.DERIV'
4391 include 'COMMON.CHAIN'
4392 include 'COMMON.NAMES'
4393 include 'COMMON.IOUNITS'
4394 include 'COMMON.FFIELD'
4395 include 'COMMON.TORCNSTR'
4397 C Set lprn=.true. for debugging
4401 do i=iphi_start,iphi_end-1
4402 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4404 itori=itortyp(itype(i-2))
4405 itori1=itortyp(itype(i-1))
4406 itori2=itortyp(itype(i))
4411 C Regular cosine and sine terms
4412 do j=1,ntermd_1(itori,itori1,itori2)
4413 v1cij=v1c(1,j,itori,itori1,itori2)
4414 v1sij=v1s(1,j,itori,itori1,itori2)
4415 v2cij=v1c(2,j,itori,itori1,itori2)
4416 v2sij=v1s(2,j,itori,itori1,itori2)
4417 cosphi1=dcos(j*phii)
4418 sinphi1=dsin(j*phii)
4419 cosphi2=dcos(j*phii1)
4420 sinphi2=dsin(j*phii1)
4421 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4422 & v2cij*cosphi2+v2sij*sinphi2
4423 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4424 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4426 do k=2,ntermd_2(itori,itori1,itori2)
4428 v1cdij = v2c(k,l,itori,itori1,itori2)
4429 v2cdij = v2c(l,k,itori,itori1,itori2)
4430 v1sdij = v2s(k,l,itori,itori1,itori2)
4431 v2sdij = v2s(l,k,itori,itori1,itori2)
4432 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4433 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4434 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4435 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4436 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4437 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4438 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4439 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4440 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4441 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4444 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4445 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4451 c------------------------------------------------------------------------------
4452 subroutine eback_sc_corr(esccor,fact)
4453 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4454 c conformational states; temporarily implemented as differences
4455 c between UNRES torsional potentials (dependent on three types of
4456 c residues) and the torsional potentials dependent on all 20 types
4457 c of residues computed from AM1 energy surfaces of terminally-blocked
4458 c amino-acid residues.
4459 implicit real*8 (a-h,o-z)
4460 include 'DIMENSIONS'
4461 include 'COMMON.VAR'
4462 include 'COMMON.GEO'
4463 include 'COMMON.LOCAL'
4464 include 'COMMON.TORSION'
4465 include 'COMMON.SCCOR'
4466 include 'COMMON.INTERACT'
4467 include 'COMMON.DERIV'
4468 include 'COMMON.CHAIN'
4469 include 'COMMON.NAMES'
4470 include 'COMMON.IOUNITS'
4471 include 'COMMON.FFIELD'
4472 include 'COMMON.CONTROL'
4474 C Set lprn=.true. for debugging
4477 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4479 do i=itau_start,itau_end
4481 isccori=isccortyp(itype(i-2))
4482 isccori1=isccortyp(itype(i-1))
4484 cccc Added 9 May 2012
4485 cc Tauangle is torsional engle depending on the value of first digit
4486 c(see comment below)
4487 cc Omicron is flat angle depending on the value of first digit
4488 c(see comment below)
4491 do intertyp=1,3 !intertyp
4492 cc Added 09 May 2012 (Adasko)
4493 cc Intertyp means interaction type of backbone mainchain correlation:
4494 c 1 = SC...Ca...Ca...Ca
4495 c 2 = Ca...Ca...Ca...SC
4496 c 3 = SC...Ca...Ca...SCi
4498 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4499 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4500 & (itype(i-1).eq.21)))
4501 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4502 & .or.(itype(i-2).eq.21)))
4503 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4504 & (itype(i-1).eq.21)))) cycle
4505 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4506 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4508 do j=1,nterm_sccor(isccori,isccori1)
4509 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4510 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4511 cosphi=dcos(j*tauangle(intertyp,i))
4512 sinphi=dsin(j*tauangle(intertyp,i))
4513 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4515 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
4517 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4519 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4520 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4521 c &gloc_sc(intertyp,i-3,icg)
4523 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4524 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4525 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4526 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4527 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4533 c------------------------------------------------------------------------------
4534 subroutine multibody(ecorr)
4535 C This subroutine calculates multi-body contributions to energy following
4536 C the idea of Skolnick et al. If side chains I and J make a contact and
4537 C at the same time side chains I+1 and J+1 make a contact, an extra
4538 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4539 implicit real*8 (a-h,o-z)
4540 include 'DIMENSIONS'
4541 include 'COMMON.IOUNITS'
4542 include 'COMMON.DERIV'
4543 include 'COMMON.INTERACT'
4544 include 'COMMON.CONTACTS'
4545 double precision gx(3),gx1(3)
4548 C Set lprn=.true. for debugging
4552 write (iout,'(a)') 'Contact function values:'
4554 write (iout,'(i2,20(1x,i2,f10.5))')
4555 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4570 num_conti=num_cont(i)
4571 num_conti1=num_cont(i1)
4576 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4577 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4578 cd & ' ishift=',ishift
4579 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4580 C The system gains extra energy.
4581 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4582 endif ! j1==j+-ishift
4591 c------------------------------------------------------------------------------
4592 double precision function esccorr(i,j,k,l,jj,kk)
4593 implicit real*8 (a-h,o-z)
4594 include 'DIMENSIONS'
4595 include 'COMMON.IOUNITS'
4596 include 'COMMON.DERIV'
4597 include 'COMMON.INTERACT'
4598 include 'COMMON.CONTACTS'
4599 double precision gx(3),gx1(3)
4604 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4605 C Calculate the multi-body contribution to energy.
4606 C Calculate multi-body contributions to the gradient.
4607 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4608 cd & k,l,(gacont(m,kk,k),m=1,3)
4610 gx(m) =ekl*gacont(m,jj,i)
4611 gx1(m)=eij*gacont(m,kk,k)
4612 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4613 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4614 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4615 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4619 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4624 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4630 c------------------------------------------------------------------------------
4632 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4633 implicit real*8 (a-h,o-z)
4634 include 'DIMENSIONS'
4635 integer dimen1,dimen2,atom,indx
4636 double precision buffer(dimen1,dimen2)
4637 double precision zapas
4638 common /contacts_hb/ zapas(3,20,maxres,7),
4639 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4640 & num_cont_hb(maxres),jcont_hb(20,maxres)
4641 num_kont=num_cont_hb(atom)
4645 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4648 buffer(i,indx+22)=facont_hb(i,atom)
4649 buffer(i,indx+23)=ees0p(i,atom)
4650 buffer(i,indx+24)=ees0m(i,atom)
4651 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4653 buffer(1,indx+26)=dfloat(num_kont)
4656 c------------------------------------------------------------------------------
4657 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4658 implicit real*8 (a-h,o-z)
4659 include 'DIMENSIONS'
4660 integer dimen1,dimen2,atom,indx
4661 double precision buffer(dimen1,dimen2)
4662 double precision zapas
4663 common /contacts_hb/ zapas(3,20,maxres,7),
4664 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4665 & num_cont_hb(maxres),jcont_hb(20,maxres)
4666 num_kont=buffer(1,indx+26)
4667 num_kont_old=num_cont_hb(atom)
4668 num_cont_hb(atom)=num_kont+num_kont_old
4673 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4676 facont_hb(ii,atom)=buffer(i,indx+22)
4677 ees0p(ii,atom)=buffer(i,indx+23)
4678 ees0m(ii,atom)=buffer(i,indx+24)
4679 jcont_hb(ii,atom)=buffer(i,indx+25)
4683 c------------------------------------------------------------------------------
4685 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4686 C This subroutine calculates multi-body contributions to hydrogen-bonding
4687 implicit real*8 (a-h,o-z)
4688 include 'DIMENSIONS'
4689 include 'sizesclu.dat'
4690 include 'COMMON.IOUNITS'
4692 include 'COMMON.INFO'
4694 include 'COMMON.FFIELD'
4695 include 'COMMON.DERIV'
4696 include 'COMMON.INTERACT'
4697 include 'COMMON.CONTACTS'
4699 parameter (max_cont=maxconts)
4700 parameter (max_dim=2*(8*3+2))
4701 parameter (msglen1=max_cont*max_dim*4)
4702 parameter (msglen2=2*msglen1)
4703 integer source,CorrelType,CorrelID,Error
4704 double precision buffer(max_cont,max_dim)
4706 double precision gx(3),gx1(3)
4709 C Set lprn=.true. for debugging
4714 if (fgProcs.le.1) goto 30
4716 write (iout,'(a)') 'Contact function values:'
4718 write (iout,'(2i3,50(1x,i2,f5.2))')
4719 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4720 & j=1,num_cont_hb(i))
4723 C Caution! Following code assumes that electrostatic interactions concerning
4724 C a given atom are split among at most two processors!
4734 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4737 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4738 if (MyRank.gt.0) then
4739 C Send correlation contributions to the preceding processor
4741 nn=num_cont_hb(iatel_s)
4742 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4743 cd write (iout,*) 'The BUFFER array:'
4745 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4747 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4749 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4750 C Clear the contacts of the atom passed to the neighboring processor
4751 nn=num_cont_hb(iatel_s+1)
4753 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4755 num_cont_hb(iatel_s)=0
4757 cd write (iout,*) 'Processor ',MyID,MyRank,
4758 cd & ' is sending correlation contribution to processor',MyID-1,
4759 cd & ' msglen=',msglen
4760 cd write (*,*) 'Processor ',MyID,MyRank,
4761 cd & ' is sending correlation contribution to processor',MyID-1,
4762 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4763 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4764 cd write (iout,*) 'Processor ',MyID,
4765 cd & ' has sent correlation contribution to processor',MyID-1,
4766 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4767 cd write (*,*) 'Processor ',MyID,
4768 cd & ' has sent correlation contribution to processor',MyID-1,
4769 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4771 endif ! (MyRank.gt.0)
4775 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4776 if (MyRank.lt.fgProcs-1) then
4777 C Receive correlation contributions from the next processor
4779 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4780 cd write (iout,*) 'Processor',MyID,
4781 cd & ' is receiving correlation contribution from processor',MyID+1,
4782 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4783 cd write (*,*) 'Processor',MyID,
4784 cd & ' is receiving correlation contribution from processor',MyID+1,
4785 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4787 do while (nbytes.le.0)
4788 call mp_probe(MyID+1,CorrelType,nbytes)
4790 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4791 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4792 cd write (iout,*) 'Processor',MyID,
4793 cd & ' has received correlation contribution from processor',MyID+1,
4794 cd & ' msglen=',msglen,' nbytes=',nbytes
4795 cd write (iout,*) 'The received BUFFER array:'
4797 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4799 if (msglen.eq.msglen1) then
4800 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4801 else if (msglen.eq.msglen2) then
4802 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4803 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4806 & 'ERROR!!!! message length changed while processing correlations.'
4808 & 'ERROR!!!! message length changed while processing correlations.'
4809 call mp_stopall(Error)
4810 endif ! msglen.eq.msglen1
4811 endif ! MyRank.lt.fgProcs-1
4818 write (iout,'(a)') 'Contact function values:'
4820 write (iout,'(2i3,50(1x,i2,f5.2))')
4821 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4822 & j=1,num_cont_hb(i))
4826 C Remove the loop below after debugging !!!
4833 C Calculate the local-electrostatic correlation terms
4834 do i=iatel_s,iatel_e+1
4836 num_conti=num_cont_hb(i)
4837 num_conti1=num_cont_hb(i+1)
4842 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4843 c & ' jj=',jj,' kk=',kk
4844 if (j1.eq.j+1 .or. j1.eq.j-1) then
4845 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4846 C The system gains extra energy.
4847 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4849 else if (j1.eq.j) then
4850 C Contacts I-J and I-(J+1) occur simultaneously.
4851 C The system loses extra energy.
4852 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4857 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4858 c & ' jj=',jj,' kk=',kk
4860 C Contacts I-J and (I+1)-J occur simultaneously.
4861 C The system loses extra energy.
4862 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4869 c------------------------------------------------------------------------------
4870 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4872 C This subroutine calculates multi-body contributions to hydrogen-bonding
4873 implicit real*8 (a-h,o-z)
4874 include 'DIMENSIONS'
4875 include 'sizesclu.dat'
4876 include 'COMMON.IOUNITS'
4878 include 'COMMON.INFO'
4880 include 'COMMON.FFIELD'
4881 include 'COMMON.DERIV'
4882 include 'COMMON.INTERACT'
4883 include 'COMMON.CONTACTS'
4885 parameter (max_cont=maxconts)
4886 parameter (max_dim=2*(8*3+2))
4887 parameter (msglen1=max_cont*max_dim*4)
4888 parameter (msglen2=2*msglen1)
4889 integer source,CorrelType,CorrelID,Error
4890 double precision buffer(max_cont,max_dim)
4892 double precision gx(3),gx1(3)
4895 C Set lprn=.true. for debugging
4902 if (fgProcs.le.1) goto 30
4904 write (iout,'(a)') 'Contact function values:'
4906 write (iout,'(2i3,50(1x,i2,f5.2))')
4907 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4908 & j=1,num_cont_hb(i))
4911 C Caution! Following code assumes that electrostatic interactions concerning
4912 C a given atom are split among at most two processors!
4922 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4925 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4926 if (MyRank.gt.0) then
4927 C Send correlation contributions to the preceding processor
4929 nn=num_cont_hb(iatel_s)
4930 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4931 cd write (iout,*) 'The BUFFER array:'
4933 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4935 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4937 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4938 C Clear the contacts of the atom passed to the neighboring processor
4939 nn=num_cont_hb(iatel_s+1)
4941 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4943 num_cont_hb(iatel_s)=0
4945 cd write (iout,*) 'Processor ',MyID,MyRank,
4946 cd & ' is sending correlation contribution to processor',MyID-1,
4947 cd & ' msglen=',msglen
4948 cd write (*,*) 'Processor ',MyID,MyRank,
4949 cd & ' is sending correlation contribution to processor',MyID-1,
4950 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4951 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4952 cd write (iout,*) 'Processor ',MyID,
4953 cd & ' has sent correlation contribution to processor',MyID-1,
4954 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4955 cd write (*,*) 'Processor ',MyID,
4956 cd & ' has sent correlation contribution to processor',MyID-1,
4957 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4959 endif ! (MyRank.gt.0)
4963 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4964 if (MyRank.lt.fgProcs-1) then
4965 C Receive correlation contributions from the next processor
4967 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4968 cd write (iout,*) 'Processor',MyID,
4969 cd & ' is receiving correlation contribution from processor',MyID+1,
4970 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4971 cd write (*,*) 'Processor',MyID,
4972 cd & ' is receiving correlation contribution from processor',MyID+1,
4973 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4975 do while (nbytes.le.0)
4976 call mp_probe(MyID+1,CorrelType,nbytes)
4978 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4979 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4980 cd write (iout,*) 'Processor',MyID,
4981 cd & ' has received correlation contribution from processor',MyID+1,
4982 cd & ' msglen=',msglen,' nbytes=',nbytes
4983 cd write (iout,*) 'The received BUFFER array:'
4985 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4987 if (msglen.eq.msglen1) then
4988 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4989 else if (msglen.eq.msglen2) then
4990 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4991 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4994 & 'ERROR!!!! message length changed while processing correlations.'
4996 & 'ERROR!!!! message length changed while processing correlations.'
4997 call mp_stopall(Error)
4998 endif ! msglen.eq.msglen1
4999 endif ! MyRank.lt.fgProcs-1
5006 write (iout,'(a)') 'Contact function values:'
5008 write (iout,'(2i3,50(1x,i2,f5.2))')
5009 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5010 & j=1,num_cont_hb(i))
5016 C Remove the loop below after debugging !!!
5023 C Calculate the dipole-dipole interaction energies
5024 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5025 do i=iatel_s,iatel_e+1
5026 num_conti=num_cont_hb(i)
5033 C Calculate the local-electrostatic correlation terms
5034 do i=iatel_s,iatel_e+1
5036 num_conti=num_cont_hb(i)
5037 num_conti1=num_cont_hb(i+1)
5042 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5043 c & ' jj=',jj,' kk=',kk
5044 if (j1.eq.j+1 .or. j1.eq.j-1) then
5045 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5046 C The system gains extra energy.
5048 sqd1=dsqrt(d_cont(jj,i))
5049 sqd2=dsqrt(d_cont(kk,i1))
5050 sred_geom = sqd1*sqd2
5051 IF (sred_geom.lt.cutoff_corr) THEN
5052 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5054 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5055 c & ' jj=',jj,' kk=',kk
5056 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5057 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5059 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5060 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5063 cd write (iout,*) 'sred_geom=',sred_geom,
5064 cd & ' ekont=',ekont,' fprim=',fprimcont
5065 call calc_eello(i,j,i+1,j1,jj,kk)
5066 if (wcorr4.gt.0.0d0)
5067 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5068 if (wcorr5.gt.0.0d0)
5069 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5070 c print *,"wcorr5",ecorr5
5071 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5072 cd write(2,*)'ijkl',i,j,i+1,j1
5073 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5074 & .or. wturn6.eq.0.0d0))then
5075 c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5076 c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5077 c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5078 c & 'ecorr6=',ecorr6, wcorr6
5079 cd write (iout,'(4e15.5)') sred_geom,
5080 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5081 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5082 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5083 else if (wturn6.gt.0.0d0
5084 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5085 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5086 eturn6=eturn6+eello_turn6(i,jj,kk)
5087 cd write (2,*) 'multibody_eello:eturn6',eturn6
5091 else if (j1.eq.j) then
5092 C Contacts I-J and I-(J+1) occur simultaneously.
5093 C The system loses extra energy.
5094 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5099 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5100 c & ' jj=',jj,' kk=',kk
5102 C Contacts I-J and (I+1)-J occur simultaneously.
5103 C The system loses extra energy.
5104 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5111 c------------------------------------------------------------------------------
5112 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5113 implicit real*8 (a-h,o-z)
5114 include 'DIMENSIONS'
5115 include 'COMMON.IOUNITS'
5116 include 'COMMON.DERIV'
5117 include 'COMMON.INTERACT'
5118 include 'COMMON.CONTACTS'
5119 double precision gx(3),gx1(3)
5129 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5130 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5131 C Following 4 lines for diagnostics.
5136 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5138 c write (iout,*)'Contacts have occurred for peptide groups',
5139 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5140 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5141 C Calculate the multi-body contribution to energy.
5142 ecorr=ecorr+ekont*ees
5144 C Calculate multi-body contributions to the gradient.
5146 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5147 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5148 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5149 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5150 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5151 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5152 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5153 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5154 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5155 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5156 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5157 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5158 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5159 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5163 gradcorr(ll,m)=gradcorr(ll,m)+
5164 & ees*ekl*gacont_hbr(ll,jj,i)-
5165 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5166 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5171 gradcorr(ll,m)=gradcorr(ll,m)+
5172 & ees*eij*gacont_hbr(ll,kk,k)-
5173 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5174 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5181 C---------------------------------------------------------------------------
5182 subroutine dipole(i,j,jj)
5183 implicit real*8 (a-h,o-z)
5184 include 'DIMENSIONS'
5185 include 'sizesclu.dat'
5186 include 'COMMON.IOUNITS'
5187 include 'COMMON.CHAIN'
5188 include 'COMMON.FFIELD'
5189 include 'COMMON.DERIV'
5190 include 'COMMON.INTERACT'
5191 include 'COMMON.CONTACTS'
5192 include 'COMMON.TORSION'
5193 include 'COMMON.VAR'
5194 include 'COMMON.GEO'
5195 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5197 iti1 = itortyp(itype(i+1))
5198 if (j.lt.nres-1) then
5199 itj1 = itortyp(itype(j+1))
5204 dipi(iii,1)=Ub2(iii,i)
5205 dipderi(iii)=Ub2der(iii,i)
5206 dipi(iii,2)=b1(iii,iti1)
5207 dipj(iii,1)=Ub2(iii,j)
5208 dipderj(iii)=Ub2der(iii,j)
5209 dipj(iii,2)=b1(iii,itj1)
5213 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5216 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5219 if (.not.calc_grad) return
5224 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5228 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5233 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5234 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5236 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5238 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5240 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5244 C---------------------------------------------------------------------------
5245 subroutine calc_eello(i,j,k,l,jj,kk)
5247 C This subroutine computes matrices and vectors needed to calculate
5248 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5250 implicit real*8 (a-h,o-z)
5251 include 'DIMENSIONS'
5252 include 'sizesclu.dat'
5253 include 'COMMON.IOUNITS'
5254 include 'COMMON.CHAIN'
5255 include 'COMMON.DERIV'
5256 include 'COMMON.INTERACT'
5257 include 'COMMON.CONTACTS'
5258 include 'COMMON.TORSION'
5259 include 'COMMON.VAR'
5260 include 'COMMON.GEO'
5261 include 'COMMON.FFIELD'
5262 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5263 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5266 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5267 cd & ' jj=',jj,' kk=',kk
5268 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5271 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5272 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5275 call transpose2(aa1(1,1),aa1t(1,1))
5276 call transpose2(aa2(1,1),aa2t(1,1))
5279 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5280 & aa1tder(1,1,lll,kkk))
5281 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5282 & aa2tder(1,1,lll,kkk))
5286 C parallel orientation of the two CA-CA-CA frames.
5288 iti=itortyp(itype(i))
5292 itk1=itortyp(itype(k+1))
5293 itj=itortyp(itype(j))
5294 if (l.lt.nres-1) then
5295 itl1=itortyp(itype(l+1))
5299 C A1 kernel(j+1) A2T
5301 cd write (iout,'(3f10.5,5x,3f10.5)')
5302 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5304 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5305 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5306 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5307 C Following matrices are needed only for 6-th order cumulants
5308 IF (wcorr6.gt.0.0d0) THEN
5309 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5310 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5311 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5312 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5313 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5314 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5315 & ADtEAderx(1,1,1,1,1,1))
5317 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5318 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5319 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5320 & ADtEA1derx(1,1,1,1,1,1))
5322 C End 6-th order cumulants
5325 cd write (2,*) 'In calc_eello6'
5327 cd write (2,*) 'iii=',iii
5329 cd write (2,*) 'kkk=',kkk
5331 cd write (2,'(3(2f10.5),5x)')
5332 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5337 call transpose2(EUgder(1,1,k),auxmat(1,1))
5338 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5339 call transpose2(EUg(1,1,k),auxmat(1,1))
5340 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5341 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5345 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5346 & EAEAderx(1,1,lll,kkk,iii,1))
5350 C A1T kernel(i+1) A2
5351 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5352 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5353 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5354 C Following matrices are needed only for 6-th order cumulants
5355 IF (wcorr6.gt.0.0d0) THEN
5356 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5357 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5358 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5359 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5360 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5361 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5362 & ADtEAderx(1,1,1,1,1,2))
5363 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5364 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5365 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5366 & ADtEA1derx(1,1,1,1,1,2))
5368 C End 6-th order cumulants
5369 call transpose2(EUgder(1,1,l),auxmat(1,1))
5370 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5371 call transpose2(EUg(1,1,l),auxmat(1,1))
5372 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5373 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5377 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5378 & EAEAderx(1,1,lll,kkk,iii,2))
5383 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5384 C They are needed only when the fifth- or the sixth-order cumulants are
5386 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5387 call transpose2(AEA(1,1,1),auxmat(1,1))
5388 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5389 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5390 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5391 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5392 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5393 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5394 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5395 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5396 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5397 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5398 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5399 call transpose2(AEA(1,1,2),auxmat(1,1))
5400 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5401 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5402 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5403 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5404 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5405 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5406 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5407 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5408 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5409 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5410 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5411 C Calculate the Cartesian derivatives of the vectors.
5415 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5416 call matvec2(auxmat(1,1),b1(1,iti),
5417 & AEAb1derx(1,lll,kkk,iii,1,1))
5418 call matvec2(auxmat(1,1),Ub2(1,i),
5419 & AEAb2derx(1,lll,kkk,iii,1,1))
5420 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5421 & AEAb1derx(1,lll,kkk,iii,2,1))
5422 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5423 & AEAb2derx(1,lll,kkk,iii,2,1))
5424 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5425 call matvec2(auxmat(1,1),b1(1,itj),
5426 & AEAb1derx(1,lll,kkk,iii,1,2))
5427 call matvec2(auxmat(1,1),Ub2(1,j),
5428 & AEAb2derx(1,lll,kkk,iii,1,2))
5429 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5430 & AEAb1derx(1,lll,kkk,iii,2,2))
5431 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5432 & AEAb2derx(1,lll,kkk,iii,2,2))
5439 C Antiparallel orientation of the two CA-CA-CA frames.
5441 iti=itortyp(itype(i))
5445 itk1=itortyp(itype(k+1))
5446 itl=itortyp(itype(l))
5447 itj=itortyp(itype(j))
5448 if (j.lt.nres-1) then
5449 itj1=itortyp(itype(j+1))
5453 C A2 kernel(j-1)T A1T
5454 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5455 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5456 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5457 C Following matrices are needed only for 6-th order cumulants
5458 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5459 & j.eq.i+4 .and. l.eq.i+3)) THEN
5460 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5461 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5462 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5463 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5464 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5465 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5466 & ADtEAderx(1,1,1,1,1,1))
5467 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5468 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5469 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5470 & ADtEA1derx(1,1,1,1,1,1))
5472 C End 6-th order cumulants
5473 call transpose2(EUgder(1,1,k),auxmat(1,1))
5474 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5475 call transpose2(EUg(1,1,k),auxmat(1,1))
5476 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5477 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5481 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5482 & EAEAderx(1,1,lll,kkk,iii,1))
5486 C A2T kernel(i+1)T A1
5487 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5488 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5489 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5490 C Following matrices are needed only for 6-th order cumulants
5491 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5492 & j.eq.i+4 .and. l.eq.i+3)) THEN
5493 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5494 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5495 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5496 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5497 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5498 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5499 & ADtEAderx(1,1,1,1,1,2))
5500 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5501 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5502 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5503 & ADtEA1derx(1,1,1,1,1,2))
5505 C End 6-th order cumulants
5506 call transpose2(EUgder(1,1,j),auxmat(1,1))
5507 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5508 call transpose2(EUg(1,1,j),auxmat(1,1))
5509 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5510 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5514 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5515 & EAEAderx(1,1,lll,kkk,iii,2))
5520 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5521 C They are needed only when the fifth- or the sixth-order cumulants are
5523 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5524 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5525 call transpose2(AEA(1,1,1),auxmat(1,1))
5526 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5527 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5528 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5529 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5530 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5531 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5532 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5533 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5534 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5535 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5536 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5537 call transpose2(AEA(1,1,2),auxmat(1,1))
5538 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5539 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5540 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5541 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5542 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5543 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5544 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5545 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5546 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5547 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5548 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5549 C Calculate the Cartesian derivatives of the vectors.
5553 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5554 call matvec2(auxmat(1,1),b1(1,iti),
5555 & AEAb1derx(1,lll,kkk,iii,1,1))
5556 call matvec2(auxmat(1,1),Ub2(1,i),
5557 & AEAb2derx(1,lll,kkk,iii,1,1))
5558 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5559 & AEAb1derx(1,lll,kkk,iii,2,1))
5560 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5561 & AEAb2derx(1,lll,kkk,iii,2,1))
5562 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5563 call matvec2(auxmat(1,1),b1(1,itl),
5564 & AEAb1derx(1,lll,kkk,iii,1,2))
5565 call matvec2(auxmat(1,1),Ub2(1,l),
5566 & AEAb2derx(1,lll,kkk,iii,1,2))
5567 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5568 & AEAb1derx(1,lll,kkk,iii,2,2))
5569 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5570 & AEAb2derx(1,lll,kkk,iii,2,2))
5579 C---------------------------------------------------------------------------
5580 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5581 & KK,KKderg,AKA,AKAderg,AKAderx)
5585 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5586 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5587 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5592 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5594 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5597 cd if (lprn) write (2,*) 'In kernel'
5599 cd if (lprn) write (2,*) 'kkk=',kkk
5601 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5602 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5604 cd write (2,*) 'lll=',lll
5605 cd write (2,*) 'iii=1'
5607 cd write (2,'(3(2f10.5),5x)')
5608 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5611 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5612 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5614 cd write (2,*) 'lll=',lll
5615 cd write (2,*) 'iii=2'
5617 cd write (2,'(3(2f10.5),5x)')
5618 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5625 C---------------------------------------------------------------------------
5626 double precision function eello4(i,j,k,l,jj,kk)
5627 implicit real*8 (a-h,o-z)
5628 include 'DIMENSIONS'
5629 include 'sizesclu.dat'
5630 include 'COMMON.IOUNITS'
5631 include 'COMMON.CHAIN'
5632 include 'COMMON.DERIV'
5633 include 'COMMON.INTERACT'
5634 include 'COMMON.CONTACTS'
5635 include 'COMMON.TORSION'
5636 include 'COMMON.VAR'
5637 include 'COMMON.GEO'
5638 double precision pizda(2,2),ggg1(3),ggg2(3)
5639 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5643 cd print *,'eello4:',i,j,k,l,jj,kk
5644 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5645 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5646 cold eij=facont_hb(jj,i)
5647 cold ekl=facont_hb(kk,k)
5649 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5651 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5652 gcorr_loc(k-1)=gcorr_loc(k-1)
5653 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5655 gcorr_loc(l-1)=gcorr_loc(l-1)
5656 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5658 gcorr_loc(j-1)=gcorr_loc(j-1)
5659 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5664 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5665 & -EAEAderx(2,2,lll,kkk,iii,1)
5666 cd derx(lll,kkk,iii)=0.0d0
5670 cd gcorr_loc(l-1)=0.0d0
5671 cd gcorr_loc(j-1)=0.0d0
5672 cd gcorr_loc(k-1)=0.0d0
5674 cd write (iout,*)'Contacts have occurred for peptide groups',
5675 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5676 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5677 if (j.lt.nres-1) then
5684 if (l.lt.nres-1) then
5692 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5693 ggg1(ll)=eel4*g_contij(ll,1)
5694 ggg2(ll)=eel4*g_contij(ll,2)
5695 ghalf=0.5d0*ggg1(ll)
5697 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5698 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5699 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5700 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5701 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5702 ghalf=0.5d0*ggg2(ll)
5704 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5705 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5706 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5707 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5712 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5713 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5718 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5719 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5725 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5730 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5734 cd write (2,*) iii,gcorr_loc(iii)
5738 cd write (2,*) 'ekont',ekont
5739 cd write (iout,*) 'eello4',ekont*eel4
5742 C---------------------------------------------------------------------------
5743 double precision function eello5(i,j,k,l,jj,kk)
5744 implicit real*8 (a-h,o-z)
5745 include 'DIMENSIONS'
5746 include 'sizesclu.dat'
5747 include 'COMMON.IOUNITS'
5748 include 'COMMON.CHAIN'
5749 include 'COMMON.DERIV'
5750 include 'COMMON.INTERACT'
5751 include 'COMMON.CONTACTS'
5752 include 'COMMON.TORSION'
5753 include 'COMMON.VAR'
5754 include 'COMMON.GEO'
5755 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5756 double precision ggg1(3),ggg2(3)
5757 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5762 C /l\ / \ \ / \ / \ / C
5763 C / \ / \ \ / \ / \ / C
5764 C j| o |l1 | o | o| o | | o |o C
5765 C \ |/k\| |/ \| / |/ \| |/ \| C
5766 C \i/ \ / \ / / \ / \ C
5768 C (I) (II) (III) (IV) C
5770 C eello5_1 eello5_2 eello5_3 eello5_4 C
5772 C Antiparallel chains C
5775 C /j\ / \ \ / \ / \ / C
5776 C / \ / \ \ / \ / \ / C
5777 C j1| o |l | o | o| o | | o |o C
5778 C \ |/k\| |/ \| / |/ \| |/ \| C
5779 C \i/ \ / \ / / \ / \ C
5781 C (I) (II) (III) (IV) C
5783 C eello5_1 eello5_2 eello5_3 eello5_4 C
5785 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5787 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5788 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5793 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5795 itk=itortyp(itype(k))
5796 itl=itortyp(itype(l))
5797 itj=itortyp(itype(j))
5802 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5803 cd & eel5_3_num,eel5_4_num)
5807 derx(lll,kkk,iii)=0.0d0
5811 cd eij=facont_hb(jj,i)
5812 cd ekl=facont_hb(kk,k)
5814 cd write (iout,*)'Contacts have occurred for peptide groups',
5815 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5817 C Contribution from the graph I.
5818 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5819 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5820 call transpose2(EUg(1,1,k),auxmat(1,1))
5821 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5822 vv(1)=pizda(1,1)-pizda(2,2)
5823 vv(2)=pizda(1,2)+pizda(2,1)
5824 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5825 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5827 C Explicit gradient in virtual-dihedral angles.
5828 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5829 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5830 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5831 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5832 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5833 vv(1)=pizda(1,1)-pizda(2,2)
5834 vv(2)=pizda(1,2)+pizda(2,1)
5835 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5836 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5837 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5838 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5839 vv(1)=pizda(1,1)-pizda(2,2)
5840 vv(2)=pizda(1,2)+pizda(2,1)
5842 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5843 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5844 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5846 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5847 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5848 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5850 C Cartesian gradient
5854 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5856 vv(1)=pizda(1,1)-pizda(2,2)
5857 vv(2)=pizda(1,2)+pizda(2,1)
5858 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5859 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5860 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5867 C Contribution from graph II
5868 call transpose2(EE(1,1,itk),auxmat(1,1))
5869 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5870 vv(1)=pizda(1,1)+pizda(2,2)
5871 vv(2)=pizda(2,1)-pizda(1,2)
5872 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5873 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5875 C Explicit gradient in virtual-dihedral angles.
5876 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5877 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5878 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5879 vv(1)=pizda(1,1)+pizda(2,2)
5880 vv(2)=pizda(2,1)-pizda(1,2)
5882 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5883 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5884 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5886 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5887 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5888 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5890 C Cartesian gradient
5894 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5896 vv(1)=pizda(1,1)+pizda(2,2)
5897 vv(2)=pizda(2,1)-pizda(1,2)
5898 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5899 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5900 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5909 C Parallel orientation
5910 C Contribution from graph III
5911 call transpose2(EUg(1,1,l),auxmat(1,1))
5912 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5913 vv(1)=pizda(1,1)-pizda(2,2)
5914 vv(2)=pizda(1,2)+pizda(2,1)
5915 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5916 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5918 C Explicit gradient in virtual-dihedral angles.
5919 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5920 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5921 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5922 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5923 vv(1)=pizda(1,1)-pizda(2,2)
5924 vv(2)=pizda(1,2)+pizda(2,1)
5925 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5926 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5927 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5928 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5929 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5930 vv(1)=pizda(1,1)-pizda(2,2)
5931 vv(2)=pizda(1,2)+pizda(2,1)
5932 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5933 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5934 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5935 C Cartesian gradient
5939 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5941 vv(1)=pizda(1,1)-pizda(2,2)
5942 vv(2)=pizda(1,2)+pizda(2,1)
5943 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5944 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5945 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5951 C Contribution from graph IV
5953 call transpose2(EE(1,1,itl),auxmat(1,1))
5954 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5955 vv(1)=pizda(1,1)+pizda(2,2)
5956 vv(2)=pizda(2,1)-pizda(1,2)
5957 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5958 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5960 C Explicit gradient in virtual-dihedral angles.
5961 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5962 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5963 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5964 vv(1)=pizda(1,1)+pizda(2,2)
5965 vv(2)=pizda(2,1)-pizda(1,2)
5966 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5967 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5968 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5969 C Cartesian gradient
5973 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5975 vv(1)=pizda(1,1)+pizda(2,2)
5976 vv(2)=pizda(2,1)-pizda(1,2)
5977 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5978 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5979 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5985 C Antiparallel orientation
5986 C Contribution from graph III
5988 call transpose2(EUg(1,1,j),auxmat(1,1))
5989 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5990 vv(1)=pizda(1,1)-pizda(2,2)
5991 vv(2)=pizda(1,2)+pizda(2,1)
5992 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
5993 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5995 C Explicit gradient in virtual-dihedral angles.
5996 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5997 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
5998 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
5999 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6000 vv(1)=pizda(1,1)-pizda(2,2)
6001 vv(2)=pizda(1,2)+pizda(2,1)
6002 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6003 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6004 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6005 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6006 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6007 vv(1)=pizda(1,1)-pizda(2,2)
6008 vv(2)=pizda(1,2)+pizda(2,1)
6009 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6010 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6011 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6012 C Cartesian gradient
6016 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6018 vv(1)=pizda(1,1)-pizda(2,2)
6019 vv(2)=pizda(1,2)+pizda(2,1)
6020 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6021 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6022 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6028 C Contribution from graph IV
6030 call transpose2(EE(1,1,itj),auxmat(1,1))
6031 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6032 vv(1)=pizda(1,1)+pizda(2,2)
6033 vv(2)=pizda(2,1)-pizda(1,2)
6034 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6035 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6037 C Explicit gradient in virtual-dihedral angles.
6038 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6039 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6040 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6041 vv(1)=pizda(1,1)+pizda(2,2)
6042 vv(2)=pizda(2,1)-pizda(1,2)
6043 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6044 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6045 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6046 C Cartesian gradient
6050 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6052 vv(1)=pizda(1,1)+pizda(2,2)
6053 vv(2)=pizda(2,1)-pizda(1,2)
6054 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6055 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6056 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6063 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6064 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6065 cd write (2,*) 'ijkl',i,j,k,l
6066 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6067 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6069 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6070 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6071 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6072 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6074 if (j.lt.nres-1) then
6081 if (l.lt.nres-1) then
6091 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6093 ggg1(ll)=eel5*g_contij(ll,1)
6094 ggg2(ll)=eel5*g_contij(ll,2)
6095 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6096 ghalf=0.5d0*ggg1(ll)
6098 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6099 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6100 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6101 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6102 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6103 ghalf=0.5d0*ggg2(ll)
6105 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6106 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6107 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6108 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6113 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6114 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6119 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6120 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6126 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6131 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6135 cd write (2,*) iii,g_corr5_loc(iii)
6139 cd write (2,*) 'ekont',ekont
6140 cd write (iout,*) 'eello5',ekont*eel5
6143 c--------------------------------------------------------------------------
6144 double precision function eello6(i,j,k,l,jj,kk)
6145 implicit real*8 (a-h,o-z)
6146 include 'DIMENSIONS'
6147 include 'sizesclu.dat'
6148 include 'COMMON.IOUNITS'
6149 include 'COMMON.CHAIN'
6150 include 'COMMON.DERIV'
6151 include 'COMMON.INTERACT'
6152 include 'COMMON.CONTACTS'
6153 include 'COMMON.TORSION'
6154 include 'COMMON.VAR'
6155 include 'COMMON.GEO'
6156 include 'COMMON.FFIELD'
6157 double precision ggg1(3),ggg2(3)
6158 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6163 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6171 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6172 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6176 derx(lll,kkk,iii)=0.0d0
6180 cd eij=facont_hb(jj,i)
6181 cd ekl=facont_hb(kk,k)
6187 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6188 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6189 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6190 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6191 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6192 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6194 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6195 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6196 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6197 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6198 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6199 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6203 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6205 C If turn contributions are considered, they will be handled separately.
6206 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6207 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6208 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6209 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6210 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6211 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6212 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6215 if (j.lt.nres-1) then
6222 if (l.lt.nres-1) then
6230 ggg1(ll)=eel6*g_contij(ll,1)
6231 ggg2(ll)=eel6*g_contij(ll,2)
6232 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6233 ghalf=0.5d0*ggg1(ll)
6235 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6236 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6237 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6238 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6239 ghalf=0.5d0*ggg2(ll)
6240 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6242 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6243 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6244 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6245 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6250 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6251 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6256 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6257 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6263 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6268 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6272 cd write (2,*) iii,g_corr6_loc(iii)
6276 cd write (2,*) 'ekont',ekont
6277 cd write (iout,*) 'eello6',ekont*eel6
6280 c--------------------------------------------------------------------------
6281 double precision function eello6_graph1(i,j,k,l,imat,swap)
6282 implicit real*8 (a-h,o-z)
6283 include 'DIMENSIONS'
6284 include 'sizesclu.dat'
6285 include 'COMMON.IOUNITS'
6286 include 'COMMON.CHAIN'
6287 include 'COMMON.DERIV'
6288 include 'COMMON.INTERACT'
6289 include 'COMMON.CONTACTS'
6290 include 'COMMON.TORSION'
6291 include 'COMMON.VAR'
6292 include 'COMMON.GEO'
6293 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6297 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6299 C Parallel Antiparallel C
6305 C \ j|/k\| / \ |/k\|l / C
6310 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6311 itk=itortyp(itype(k))
6312 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6313 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6314 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6315 call transpose2(EUgC(1,1,k),auxmat(1,1))
6316 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6317 vv1(1)=pizda1(1,1)-pizda1(2,2)
6318 vv1(2)=pizda1(1,2)+pizda1(2,1)
6319 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6320 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6321 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6322 s5=scalar2(vv(1),Dtobr2(1,i))
6323 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6324 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6325 if (.not. calc_grad) return
6326 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6327 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6328 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6329 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6330 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6331 & +scalar2(vv(1),Dtobr2der(1,i)))
6332 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6333 vv1(1)=pizda1(1,1)-pizda1(2,2)
6334 vv1(2)=pizda1(1,2)+pizda1(2,1)
6335 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6336 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6338 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6339 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6340 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6341 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6342 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6344 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6345 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6346 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6347 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6348 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6350 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6351 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6352 vv1(1)=pizda1(1,1)-pizda1(2,2)
6353 vv1(2)=pizda1(1,2)+pizda1(2,1)
6354 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6355 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6356 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6357 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6366 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6367 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6368 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6369 call transpose2(EUgC(1,1,k),auxmat(1,1))
6370 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6372 vv1(1)=pizda1(1,1)-pizda1(2,2)
6373 vv1(2)=pizda1(1,2)+pizda1(2,1)
6374 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6375 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6376 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6377 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6378 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6379 s5=scalar2(vv(1),Dtobr2(1,i))
6380 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6386 c----------------------------------------------------------------------------
6387 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6388 implicit real*8 (a-h,o-z)
6389 include 'DIMENSIONS'
6390 include 'sizesclu.dat'
6391 include 'COMMON.IOUNITS'
6392 include 'COMMON.CHAIN'
6393 include 'COMMON.DERIV'
6394 include 'COMMON.INTERACT'
6395 include 'COMMON.CONTACTS'
6396 include 'COMMON.TORSION'
6397 include 'COMMON.VAR'
6398 include 'COMMON.GEO'
6400 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6401 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6404 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6406 C Parallel Antiparallel C
6412 C \ j|/k\| \ |/k\|l C
6417 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6418 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6419 C AL 7/4/01 s1 would occur in the sixth-order moment,
6420 C but not in a cluster cumulant
6422 s1=dip(1,jj,i)*dip(1,kk,k)
6424 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6425 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6426 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6427 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6428 call transpose2(EUg(1,1,k),auxmat(1,1))
6429 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6430 vv(1)=pizda(1,1)-pizda(2,2)
6431 vv(2)=pizda(1,2)+pizda(2,1)
6432 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6433 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6435 eello6_graph2=-(s1+s2+s3+s4)
6437 eello6_graph2=-(s2+s3+s4)
6440 if (.not. calc_grad) return
6441 C Derivatives in gamma(i-1)
6444 s1=dipderg(1,jj,i)*dip(1,kk,k)
6446 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6447 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6448 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6449 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6451 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6453 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6455 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6457 C Derivatives in gamma(k-1)
6459 s1=dip(1,jj,i)*dipderg(1,kk,k)
6461 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6462 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6463 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6464 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6465 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6466 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6467 vv(1)=pizda(1,1)-pizda(2,2)
6468 vv(2)=pizda(1,2)+pizda(2,1)
6469 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6471 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6473 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6475 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6476 C Derivatives in gamma(j-1) or gamma(l-1)
6479 s1=dipderg(3,jj,i)*dip(1,kk,k)
6481 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6482 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6483 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6484 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6485 vv(1)=pizda(1,1)-pizda(2,2)
6486 vv(2)=pizda(1,2)+pizda(2,1)
6487 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6490 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6492 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6495 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6496 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6498 C Derivatives in gamma(l-1) or gamma(j-1)
6501 s1=dip(1,jj,i)*dipderg(3,kk,k)
6503 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6504 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6505 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6506 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6507 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6508 vv(1)=pizda(1,1)-pizda(2,2)
6509 vv(2)=pizda(1,2)+pizda(2,1)
6510 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6513 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6515 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6518 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6519 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6521 C Cartesian derivatives.
6523 write (2,*) 'In eello6_graph2'
6525 write (2,*) 'iii=',iii
6527 write (2,*) 'kkk=',kkk
6529 write (2,'(3(2f10.5),5x)')
6530 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6540 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6542 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6545 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6547 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6548 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6550 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6551 call transpose2(EUg(1,1,k),auxmat(1,1))
6552 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6554 vv(1)=pizda(1,1)-pizda(2,2)
6555 vv(2)=pizda(1,2)+pizda(2,1)
6556 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6557 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6559 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6561 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6564 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6566 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6573 c----------------------------------------------------------------------------
6574 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6575 implicit real*8 (a-h,o-z)
6576 include 'DIMENSIONS'
6577 include 'sizesclu.dat'
6578 include 'COMMON.IOUNITS'
6579 include 'COMMON.CHAIN'
6580 include 'COMMON.DERIV'
6581 include 'COMMON.INTERACT'
6582 include 'COMMON.CONTACTS'
6583 include 'COMMON.TORSION'
6584 include 'COMMON.VAR'
6585 include 'COMMON.GEO'
6586 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6588 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6590 C Parallel Antiparallel C
6596 C j|/k\| / |/k\|l / C
6601 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6603 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6604 C energy moment and not to the cluster cumulant.
6605 iti=itortyp(itype(i))
6606 if (j.lt.nres-1) then
6607 itj1=itortyp(itype(j+1))
6611 itk=itortyp(itype(k))
6612 itk1=itortyp(itype(k+1))
6613 if (l.lt.nres-1) then
6614 itl1=itortyp(itype(l+1))
6619 s1=dip(4,jj,i)*dip(4,kk,k)
6621 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6622 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6623 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6624 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6625 call transpose2(EE(1,1,itk),auxmat(1,1))
6626 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6627 vv(1)=pizda(1,1)+pizda(2,2)
6628 vv(2)=pizda(2,1)-pizda(1,2)
6629 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6630 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6632 eello6_graph3=-(s1+s2+s3+s4)
6634 eello6_graph3=-(s2+s3+s4)
6637 if (.not. calc_grad) return
6638 C Derivatives in gamma(k-1)
6639 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6640 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6641 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6642 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6643 C Derivatives in gamma(l-1)
6644 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6645 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6646 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6647 vv(1)=pizda(1,1)+pizda(2,2)
6648 vv(2)=pizda(2,1)-pizda(1,2)
6649 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6650 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6651 C Cartesian derivatives.
6657 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6659 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6662 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6664 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6665 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6667 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6668 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6670 vv(1)=pizda(1,1)+pizda(2,2)
6671 vv(2)=pizda(2,1)-pizda(1,2)
6672 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6674 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6676 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6679 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6681 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6683 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6689 c----------------------------------------------------------------------------
6690 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6691 implicit real*8 (a-h,o-z)
6692 include 'DIMENSIONS'
6693 include 'sizesclu.dat'
6694 include 'COMMON.IOUNITS'
6695 include 'COMMON.CHAIN'
6696 include 'COMMON.DERIV'
6697 include 'COMMON.INTERACT'
6698 include 'COMMON.CONTACTS'
6699 include 'COMMON.TORSION'
6700 include 'COMMON.VAR'
6701 include 'COMMON.GEO'
6702 include 'COMMON.FFIELD'
6703 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6704 & auxvec1(2),auxmat1(2,2)
6706 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6708 C Parallel Antiparallel C
6714 C \ j|/k\| \ |/k\|l C
6719 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6721 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6722 C energy moment and not to the cluster cumulant.
6723 cd write (2,*) 'eello_graph4: wturn6',wturn6
6724 iti=itortyp(itype(i))
6725 itj=itortyp(itype(j))
6726 if (j.lt.nres-1) then
6727 itj1=itortyp(itype(j+1))
6731 itk=itortyp(itype(k))
6732 if (k.lt.nres-1) then
6733 itk1=itortyp(itype(k+1))
6737 itl=itortyp(itype(l))
6738 if (l.lt.nres-1) then
6739 itl1=itortyp(itype(l+1))
6743 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6744 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6745 cd & ' itl',itl,' itl1',itl1
6748 s1=dip(3,jj,i)*dip(3,kk,k)
6750 s1=dip(2,jj,j)*dip(2,kk,l)
6753 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6754 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6756 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6757 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6759 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6760 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6762 call transpose2(EUg(1,1,k),auxmat(1,1))
6763 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6764 vv(1)=pizda(1,1)-pizda(2,2)
6765 vv(2)=pizda(2,1)+pizda(1,2)
6766 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6767 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6769 eello6_graph4=-(s1+s2+s3+s4)
6771 eello6_graph4=-(s2+s3+s4)
6773 if (.not. calc_grad) return
6774 C Derivatives in gamma(i-1)
6778 s1=dipderg(2,jj,i)*dip(3,kk,k)
6780 s1=dipderg(4,jj,j)*dip(2,kk,l)
6783 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6785 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6786 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6788 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6789 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6791 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6792 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6793 cd write (2,*) 'turn6 derivatives'
6795 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6797 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6801 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6803 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6807 C Derivatives in gamma(k-1)
6810 s1=dip(3,jj,i)*dipderg(2,kk,k)
6812 s1=dip(2,jj,j)*dipderg(4,kk,l)
6815 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6816 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6818 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6819 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6821 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6822 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6824 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6825 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6826 vv(1)=pizda(1,1)-pizda(2,2)
6827 vv(2)=pizda(2,1)+pizda(1,2)
6828 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6829 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6831 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6833 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6837 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6839 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6842 C Derivatives in gamma(j-1) or gamma(l-1)
6843 if (l.eq.j+1 .and. l.gt.1) then
6844 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6845 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6846 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6847 vv(1)=pizda(1,1)-pizda(2,2)
6848 vv(2)=pizda(2,1)+pizda(1,2)
6849 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6850 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6851 else if (j.gt.1) then
6852 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6853 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6854 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6855 vv(1)=pizda(1,1)-pizda(2,2)
6856 vv(2)=pizda(2,1)+pizda(1,2)
6857 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6858 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6859 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6861 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6864 C Cartesian derivatives.
6871 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6873 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6877 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6879 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6883 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6885 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6887 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6888 & b1(1,itj1),auxvec(1))
6889 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6891 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6892 & b1(1,itl1),auxvec(1))
6893 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6895 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6897 vv(1)=pizda(1,1)-pizda(2,2)
6898 vv(2)=pizda(2,1)+pizda(1,2)
6899 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6901 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6903 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6906 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6909 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6912 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6914 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6916 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6920 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6922 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6925 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6927 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6935 c----------------------------------------------------------------------------
6936 double precision function eello_turn6(i,jj,kk)
6937 implicit real*8 (a-h,o-z)
6938 include 'DIMENSIONS'
6939 include 'sizesclu.dat'
6940 include 'COMMON.IOUNITS'
6941 include 'COMMON.CHAIN'
6942 include 'COMMON.DERIV'
6943 include 'COMMON.INTERACT'
6944 include 'COMMON.CONTACTS'
6945 include 'COMMON.TORSION'
6946 include 'COMMON.VAR'
6947 include 'COMMON.GEO'
6948 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6949 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6951 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6952 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6953 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6954 C the respective energy moment and not to the cluster cumulant.
6959 iti=itortyp(itype(i))
6960 itk=itortyp(itype(k))
6961 itk1=itortyp(itype(k+1))
6962 itl=itortyp(itype(l))
6963 itj=itortyp(itype(j))
6964 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6965 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6966 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6971 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6973 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6977 derx_turn(lll,kkk,iii)=0.0d0
6984 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6986 cd write (2,*) 'eello6_5',eello6_5
6988 call transpose2(AEA(1,1,1),auxmat(1,1))
6989 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
6990 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
6991 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
6995 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
6996 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
6997 s2 = scalar2(b1(1,itk),vtemp1(1))
6999 call transpose2(AEA(1,1,2),atemp(1,1))
7000 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7001 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7002 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7006 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7007 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7008 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7010 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7011 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7012 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7013 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7014 ss13 = scalar2(b1(1,itk),vtemp4(1))
7015 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7019 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7025 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7027 C Derivatives in gamma(i+2)
7029 call transpose2(AEA(1,1,1),auxmatd(1,1))
7030 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7031 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7032 call transpose2(AEAderg(1,1,2),atempd(1,1))
7033 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7034 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7038 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7039 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7040 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7046 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7047 C Derivatives in gamma(i+3)
7049 call transpose2(AEA(1,1,1),auxmatd(1,1))
7050 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7051 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7052 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7056 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7057 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7058 s2d = scalar2(b1(1,itk),vtemp1d(1))
7060 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7061 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7063 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7065 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7066 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7067 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7077 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7078 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7080 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7081 & -0.5d0*ekont*(s2d+s12d)
7083 C Derivatives in gamma(i+4)
7084 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7085 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7086 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7088 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7089 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7090 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7100 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7102 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7104 C Derivatives in gamma(i+5)
7106 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7107 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7108 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7112 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7113 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7114 s2d = scalar2(b1(1,itk),vtemp1d(1))
7116 call transpose2(AEA(1,1,2),atempd(1,1))
7117 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7118 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7122 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7123 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7125 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7126 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7127 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7137 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7138 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7140 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7141 & -0.5d0*ekont*(s2d+s12d)
7143 C Cartesian derivatives
7148 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7149 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7150 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7154 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7155 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7157 s2d = scalar2(b1(1,itk),vtemp1d(1))
7159 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7160 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7161 s8d = -(atempd(1,1)+atempd(2,2))*
7162 & scalar2(cc(1,1,itl),vtemp2(1))
7166 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7168 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7169 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7176 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7179 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7183 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7184 & - 0.5d0*(s8d+s12d)
7186 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7195 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7197 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7198 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7199 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7200 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7201 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7203 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7204 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7205 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7209 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7210 cd & 16*eel_turn6_num
7212 if (j.lt.nres-1) then
7219 if (l.lt.nres-1) then
7227 ggg1(ll)=eel_turn6*g_contij(ll,1)
7228 ggg2(ll)=eel_turn6*g_contij(ll,2)
7229 ghalf=0.5d0*ggg1(ll)
7231 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7232 & +ekont*derx_turn(ll,2,1)
7233 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7234 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7235 & +ekont*derx_turn(ll,4,1)
7236 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7237 ghalf=0.5d0*ggg2(ll)
7239 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7240 & +ekont*derx_turn(ll,2,2)
7241 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7242 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7243 & +ekont*derx_turn(ll,4,2)
7244 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7249 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7254 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7260 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7265 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7269 cd write (2,*) iii,g_corr6_loc(iii)
7272 eello_turn6=ekont*eel_turn6
7273 cd write (2,*) 'ekont',ekont
7274 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7277 crc-------------------------------------------------
7278 SUBROUTINE MATVEC2(A1,V1,V2)
7279 implicit real*8 (a-h,o-z)
7280 include 'DIMENSIONS'
7281 DIMENSION A1(2,2),V1(2),V2(2)
7285 c 3 VI=VI+A1(I,K)*V1(K)
7289 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7290 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7295 C---------------------------------------
7296 SUBROUTINE MATMAT2(A1,A2,A3)
7297 implicit real*8 (a-h,o-z)
7298 include 'DIMENSIONS'
7299 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7300 c DIMENSION AI3(2,2)
7304 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7310 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7311 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7312 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7313 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7321 c-------------------------------------------------------------------------
7322 double precision function scalar2(u,v)
7324 double precision u(2),v(2)
7327 scalar2=u(1)*v(1)+u(2)*v(2)
7331 C-----------------------------------------------------------------------------
7333 subroutine transpose2(a,at)
7335 double precision a(2,2),at(2,2)
7342 c--------------------------------------------------------------------------
7343 subroutine transpose(n,a,at)
7346 double precision a(n,n),at(n,n)
7354 C---------------------------------------------------------------------------
7355 subroutine prodmat3(a1,a2,kk,transp,prod)
7358 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7360 crc double precision auxmat(2,2),prod_(2,2)
7363 crc call transpose2(kk(1,1),auxmat(1,1))
7364 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7365 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7367 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7368 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7369 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7370 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7371 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7372 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7373 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7374 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7377 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7378 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7380 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7381 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7382 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7383 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7384 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7385 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7386 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7387 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7390 c call transpose2(a2(1,1),a2t(1,1))
7393 crc print *,((prod_(i,j),i=1,2),j=1,2)
7394 crc print *,((prod(i,j),i=1,2),j=1,2)
7398 C-----------------------------------------------------------------------------
7399 double precision function scalar(u,v)
7401 double precision u(3),v(3)