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
3361 theti2=0.5d0*theta(i)
3362 ityp2=ithetyp(itype(i-1))
3364 coskt(k)=dcos(k*theti2)
3365 sinkt(k)=dsin(k*theti2)
3370 if (phii.ne.phii) phii=150.0
3374 ityp1=ithetyp(itype(i-2))
3376 cosph1(k)=dcos(k*phii)
3377 sinph1(k)=dsin(k*phii)
3390 if (phii1.ne.phii1) phii1=150.0
3395 ityp3=ithetyp(itype(i))
3397 cosph2(k)=dcos(k*phii1)
3398 sinph2(k)=dsin(k*phii1)
3408 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3409 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3411 ethetai=aa0thet(ityp1,ityp2,ityp3)
3414 ccl=cosph1(l)*cosph2(k-l)
3415 ssl=sinph1(l)*sinph2(k-l)
3416 scl=sinph1(l)*cosph2(k-l)
3417 csl=cosph1(l)*sinph2(k-l)
3418 cosph1ph2(l,k)=ccl-ssl
3419 cosph1ph2(k,l)=ccl+ssl
3420 sinph1ph2(l,k)=scl+csl
3421 sinph1ph2(k,l)=scl-csl
3425 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3426 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3427 write (iout,*) "coskt and sinkt"
3429 write (iout,*) k,coskt(k),sinkt(k)
3433 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3434 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3437 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3438 & " ethetai",ethetai
3441 write (iout,*) "cosph and sinph"
3443 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3445 write (iout,*) "cosph1ph2 and sinph2ph2"
3448 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3449 & sinph1ph2(l,k),sinph1ph2(k,l)
3452 write(iout,*) "ethetai",ethetai
3456 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3457 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3458 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3459 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3460 ethetai=ethetai+sinkt(m)*aux
3461 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3462 dephii=dephii+k*sinkt(m)*(
3463 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3464 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3465 dephii1=dephii1+k*sinkt(m)*(
3466 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3467 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3469 & write (iout,*) "m",m," k",k," bbthet",
3470 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3471 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3472 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3473 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3477 & write(iout,*) "ethetai",ethetai
3481 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3482 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3483 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3484 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3485 ethetai=ethetai+sinkt(m)*aux
3486 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3487 dephii=dephii+l*sinkt(m)*(
3488 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3489 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3490 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3491 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3492 dephii1=dephii1+(k-l)*sinkt(m)*(
3493 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3494 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3495 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3496 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3498 write (iout,*) "m",m," k",k," l",l," ffthet",
3499 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3500 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3501 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3502 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3503 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3504 & cosph1ph2(k,l)*sinkt(m),
3505 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3511 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3512 & i,theta(i)*rad2deg,phii*rad2deg,
3513 & phii1*rad2deg,ethetai
3514 etheta=etheta+ethetai
3515 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3516 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3517 gloc(nphi+i-2,icg)=wang*dethetai
3523 c-----------------------------------------------------------------------------
3524 subroutine esc(escloc)
3525 C Calculate the local energy of a side chain and its derivatives in the
3526 C corresponding virtual-bond valence angles THETA and the spherical angles
3528 implicit real*8 (a-h,o-z)
3529 include 'DIMENSIONS'
3530 include 'sizesclu.dat'
3531 include 'COMMON.GEO'
3532 include 'COMMON.LOCAL'
3533 include 'COMMON.VAR'
3534 include 'COMMON.INTERACT'
3535 include 'COMMON.DERIV'
3536 include 'COMMON.CHAIN'
3537 include 'COMMON.IOUNITS'
3538 include 'COMMON.NAMES'
3539 include 'COMMON.FFIELD'
3540 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3541 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3542 common /sccalc/ time11,time12,time112,theti,it,nlobit
3545 c write (iout,'(a)') 'ESC'
3546 do i=loc_start,loc_end
3548 if (it.eq.10) goto 1
3550 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3551 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3552 theti=theta(i+1)-pipol
3556 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3558 if (x(2).gt.pi-delta) then
3562 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3564 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3565 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3567 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3568 & ddersc0(1),dersc(1))
3569 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3570 & ddersc0(3),dersc(3))
3572 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3574 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3575 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3576 & dersc0(2),esclocbi,dersc02)
3577 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3579 call splinthet(x(2),0.5d0*delta,ss,ssd)
3584 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3586 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3587 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3589 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3591 c write (iout,*) escloci
3592 else if (x(2).lt.delta) then
3596 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3598 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3599 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3601 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3602 & ddersc0(1),dersc(1))
3603 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3604 & ddersc0(3),dersc(3))
3606 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3608 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3609 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3610 & dersc0(2),esclocbi,dersc02)
3611 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3616 call splinthet(x(2),0.5d0*delta,ss,ssd)
3618 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3620 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3621 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3623 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3624 c write (iout,*) escloci
3626 call enesc(x,escloci,dersc,ddummy,.false.)
3629 escloc=escloc+escloci
3630 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3632 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3634 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3635 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3640 C---------------------------------------------------------------------------
3641 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3642 implicit real*8 (a-h,o-z)
3643 include 'DIMENSIONS'
3644 include 'COMMON.GEO'
3645 include 'COMMON.LOCAL'
3646 include 'COMMON.IOUNITS'
3647 common /sccalc/ time11,time12,time112,theti,it,nlobit
3648 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3649 double precision contr(maxlob,-1:1)
3651 c write (iout,*) 'it=',it,' nlobit=',nlobit
3655 if (mixed) ddersc(j)=0.0d0
3659 C Because of periodicity of the dependence of the SC energy in omega we have
3660 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3661 C To avoid underflows, first compute & store the exponents.
3669 z(k)=x(k)-censc(k,j,it)
3674 Axk=Axk+gaussc(l,k,j,it)*z(l)
3680 expfac=expfac+Ax(k,j,iii)*z(k)
3688 C As in the case of ebend, we want to avoid underflows in exponentiation and
3689 C subsequent NaNs and INFs in energy calculation.
3690 C Find the largest exponent
3694 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3698 cd print *,'it=',it,' emin=',emin
3700 C Compute the contribution to SC energy and derivatives
3704 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3705 cd print *,'j=',j,' expfac=',expfac
3706 escloc_i=escloc_i+expfac
3708 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3712 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3713 & +gaussc(k,2,j,it))*expfac
3720 dersc(1)=dersc(1)/cos(theti)**2
3721 ddersc(1)=ddersc(1)/cos(theti)**2
3724 escloci=-(dlog(escloc_i)-emin)
3726 dersc(j)=dersc(j)/escloc_i
3730 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3735 C------------------------------------------------------------------------------
3736 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3737 implicit real*8 (a-h,o-z)
3738 include 'DIMENSIONS'
3739 include 'COMMON.GEO'
3740 include 'COMMON.LOCAL'
3741 include 'COMMON.IOUNITS'
3742 common /sccalc/ time11,time12,time112,theti,it,nlobit
3743 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3744 double precision contr(maxlob)
3755 z(k)=x(k)-censc(k,j,it)
3761 Axk=Axk+gaussc(l,k,j,it)*z(l)
3767 expfac=expfac+Ax(k,j)*z(k)
3772 C As in the case of ebend, we want to avoid underflows in exponentiation and
3773 C subsequent NaNs and INFs in energy calculation.
3774 C Find the largest exponent
3777 if (emin.gt.contr(j)) emin=contr(j)
3781 C Compute the contribution to SC energy and derivatives
3785 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3786 escloc_i=escloc_i+expfac
3788 dersc(k)=dersc(k)+Ax(k,j)*expfac
3790 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3791 & +gaussc(1,2,j,it))*expfac
3795 dersc(1)=dersc(1)/cos(theti)**2
3796 dersc12=dersc12/cos(theti)**2
3797 escloci=-(dlog(escloc_i)-emin)
3799 dersc(j)=dersc(j)/escloc_i
3801 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3805 c----------------------------------------------------------------------------------
3806 subroutine esc(escloc)
3807 C Calculate the local energy of a side chain and its derivatives in the
3808 C corresponding virtual-bond valence angles THETA and the spherical angles
3809 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3810 C added by Urszula Kozlowska. 07/11/2007
3812 implicit real*8 (a-h,o-z)
3813 include 'DIMENSIONS'
3814 include 'COMMON.GEO'
3815 include 'COMMON.LOCAL'
3816 include 'COMMON.VAR'
3817 include 'COMMON.SCROT'
3818 include 'COMMON.INTERACT'
3819 include 'COMMON.DERIV'
3820 include 'COMMON.CHAIN'
3821 include 'COMMON.IOUNITS'
3822 include 'COMMON.NAMES'
3823 include 'COMMON.FFIELD'
3824 include 'COMMON.CONTROL'
3825 include 'COMMON.VECTORS'
3826 double precision x_prime(3),y_prime(3),z_prime(3)
3827 & , sumene,dsc_i,dp2_i,x(65),
3828 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3829 & de_dxx,de_dyy,de_dzz,de_dt
3830 double precision s1_t,s1_6_t,s2_t,s2_6_t
3832 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3833 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3834 & dt_dCi(3),dt_dCi1(3)
3835 common /sccalc/ time11,time12,time112,theti,it,nlobit
3838 do i=loc_start,loc_end
3839 costtab(i+1) =dcos(theta(i+1))
3840 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3841 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3842 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3843 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3844 cosfac=dsqrt(cosfac2)
3845 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3846 sinfac=dsqrt(sinfac2)
3848 if (it.eq.10) goto 1
3850 C Compute the axes of tghe local cartesian coordinates system; store in
3851 c x_prime, y_prime and z_prime
3858 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3859 C & dc_norm(3,i+nres)
3861 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3862 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3865 z_prime(j) = -uz(j,i-1)
3868 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3869 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3870 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3871 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3872 c & " xy",scalar(x_prime(1),y_prime(1)),
3873 c & " xz",scalar(x_prime(1),z_prime(1)),
3874 c & " yy",scalar(y_prime(1),y_prime(1)),
3875 c & " yz",scalar(y_prime(1),z_prime(1)),
3876 c & " zz",scalar(z_prime(1),z_prime(1))
3878 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3879 C to local coordinate system. Store in xx, yy, zz.
3885 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3886 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3887 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3894 C Compute the energy of the ith side cbain
3896 c write (2,*) "xx",xx," yy",yy," zz",zz
3899 x(j) = sc_parmin(j,it)
3902 Cc diagnostics - remove later
3904 yy1 = dsin(alph(2))*dcos(omeg(2))
3905 zz1 = -dsin(alph(2))*dsin(omeg(2))
3906 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3907 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3909 C," --- ", xx_w,yy_w,zz_w
3912 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3913 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3915 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3916 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3918 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3919 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3920 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3921 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3922 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3924 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3925 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3926 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3927 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3928 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3930 dsc_i = 0.743d0+x(61)
3932 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3933 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3934 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3935 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3936 s1=(1+x(63))/(0.1d0 + dscp1)
3937 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3938 s2=(1+x(65))/(0.1d0 + dscp2)
3939 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3940 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3941 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3942 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3944 c & dscp1,dscp2,sumene
3945 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3946 escloc = escloc + sumene
3947 c write (2,*) "escloc",escloc
3948 if (.not. calc_grad) goto 1
3951 C This section to check the numerical derivatives of the energy of ith side
3952 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3953 C #define DEBUG in the code to turn it on.
3955 write (2,*) "sumene =",sumene
3959 write (2,*) xx,yy,zz
3960 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3961 de_dxx_num=(sumenep-sumene)/aincr
3963 write (2,*) "xx+ sumene from enesc=",sumenep
3966 write (2,*) xx,yy,zz
3967 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3968 de_dyy_num=(sumenep-sumene)/aincr
3970 write (2,*) "yy+ sumene from enesc=",sumenep
3973 write (2,*) xx,yy,zz
3974 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3975 de_dzz_num=(sumenep-sumene)/aincr
3977 write (2,*) "zz+ sumene from enesc=",sumenep
3978 costsave=cost2tab(i+1)
3979 sintsave=sint2tab(i+1)
3980 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
3981 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
3982 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3983 de_dt_num=(sumenep-sumene)/aincr
3984 write (2,*) " t+ sumene from enesc=",sumenep
3985 cost2tab(i+1)=costsave
3986 sint2tab(i+1)=sintsave
3987 C End of diagnostics section.
3990 C Compute the gradient of esc
3992 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
3993 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
3994 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
3995 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
3996 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
3997 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
3998 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
3999 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4000 pom1=(sumene3*sint2tab(i+1)+sumene1)
4001 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4002 pom2=(sumene4*cost2tab(i+1)+sumene2)
4003 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4004 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4005 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4006 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4008 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4009 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4010 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4012 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4013 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4014 & +(pom1+pom2)*pom_dx
4016 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4019 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4020 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4021 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4023 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4024 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4025 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4026 & +x(59)*zz**2 +x(60)*xx*zz
4027 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4028 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4029 & +(pom1-pom2)*pom_dy
4031 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4034 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4035 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4036 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4037 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4038 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4039 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4040 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4041 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4043 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4046 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4047 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4048 & +pom1*pom_dt1+pom2*pom_dt2
4050 write(2,*), "de_dt = ", de_dt,de_dt_num
4054 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4055 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4056 cosfac2xx=cosfac2*xx
4057 sinfac2yy=sinfac2*yy
4059 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4061 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4063 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4064 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4065 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4066 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4067 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4068 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4069 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4070 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4071 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4072 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4076 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4077 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4080 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4081 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4082 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4084 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4085 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4089 dXX_Ctab(k,i)=dXX_Ci(k)
4090 dXX_C1tab(k,i)=dXX_Ci1(k)
4091 dYY_Ctab(k,i)=dYY_Ci(k)
4092 dYY_C1tab(k,i)=dYY_Ci1(k)
4093 dZZ_Ctab(k,i)=dZZ_Ci(k)
4094 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4095 dXX_XYZtab(k,i)=dXX_XYZ(k)
4096 dYY_XYZtab(k,i)=dYY_XYZ(k)
4097 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4101 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4102 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4103 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4104 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4105 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4107 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4108 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4109 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4110 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4111 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4112 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4113 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4114 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4116 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4117 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4119 C to check gradient call subroutine check_grad
4126 c------------------------------------------------------------------------------
4127 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4129 C This procedure calculates two-body contact function g(rij) and its derivative:
4132 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4135 C where x=(rij-r0ij)/delta
4137 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4140 double precision rij,r0ij,eps0ij,fcont,fprimcont
4141 double precision x,x2,x4,delta
4145 if (x.lt.-1.0D0) then
4148 else if (x.le.1.0D0) then
4151 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4152 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4159 c------------------------------------------------------------------------------
4160 subroutine splinthet(theti,delta,ss,ssder)
4161 implicit real*8 (a-h,o-z)
4162 include 'DIMENSIONS'
4163 include 'sizesclu.dat'
4164 include 'COMMON.VAR'
4165 include 'COMMON.GEO'
4168 if (theti.gt.pipol) then
4169 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4171 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4176 c------------------------------------------------------------------------------
4177 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4179 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4180 double precision ksi,ksi2,ksi3,a1,a2,a3
4181 a1=fprim0*delta/(f1-f0)
4187 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4188 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4191 c------------------------------------------------------------------------------
4192 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4194 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4195 double precision ksi,ksi2,ksi3,a1,a2,a3
4200 a2=3*(f1x-f0x)-2*fprim0x*delta
4201 a3=fprim0x*delta-2*(f1x-f0x)
4202 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4205 C-----------------------------------------------------------------------------
4207 C-----------------------------------------------------------------------------
4208 subroutine etor(etors,edihcnstr,fact)
4209 implicit real*8 (a-h,o-z)
4210 include 'DIMENSIONS'
4211 include 'sizesclu.dat'
4212 include 'COMMON.VAR'
4213 include 'COMMON.GEO'
4214 include 'COMMON.LOCAL'
4215 include 'COMMON.TORSION'
4216 include 'COMMON.INTERACT'
4217 include 'COMMON.DERIV'
4218 include 'COMMON.CHAIN'
4219 include 'COMMON.NAMES'
4220 include 'COMMON.IOUNITS'
4221 include 'COMMON.FFIELD'
4222 include 'COMMON.TORCNSTR'
4224 C Set lprn=.true. for debugging
4228 do i=iphi_start,iphi_end
4229 itori=itortyp(itype(i-2))
4230 itori1=itortyp(itype(i-1))
4233 C Proline-Proline pair is a special case...
4234 if (itori.eq.3 .and. itori1.eq.3) then
4235 if (phii.gt.-dwapi3) then
4237 fac=1.0D0/(1.0D0-cosphi)
4238 etorsi=v1(1,3,3)*fac
4239 etorsi=etorsi+etorsi
4240 etors=etors+etorsi-v1(1,3,3)
4241 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4244 v1ij=v1(j+1,itori,itori1)
4245 v2ij=v2(j+1,itori,itori1)
4248 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4249 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4253 v1ij=v1(j,itori,itori1)
4254 v2ij=v2(j,itori,itori1)
4257 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4258 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4262 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4263 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4264 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4265 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4266 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4268 ! 6/20/98 - dihedral angle constraints
4271 itori=idih_constr(i)
4273 difi=pinorm(phii-phi0(i))
4274 if (difi.gt.drange(i)) then
4276 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4277 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4278 else if (difi.lt.-drange(i)) then
4280 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4281 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4283 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4284 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4286 write (iout,*) 'edihcnstr',edihcnstr
4289 c------------------------------------------------------------------------------
4291 subroutine etor(etors,edihcnstr,fact)
4292 implicit real*8 (a-h,o-z)
4293 include 'DIMENSIONS'
4294 include 'sizesclu.dat'
4295 include 'COMMON.VAR'
4296 include 'COMMON.GEO'
4297 include 'COMMON.LOCAL'
4298 include 'COMMON.TORSION'
4299 include 'COMMON.INTERACT'
4300 include 'COMMON.DERIV'
4301 include 'COMMON.CHAIN'
4302 include 'COMMON.NAMES'
4303 include 'COMMON.IOUNITS'
4304 include 'COMMON.FFIELD'
4305 include 'COMMON.TORCNSTR'
4307 C Set lprn=.true. for debugging
4311 do i=iphi_start,iphi_end
4312 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4313 itori=itortyp(itype(i-2))
4314 itori1=itortyp(itype(i-1))
4317 C Regular cosine and sine terms
4318 do j=1,nterm(itori,itori1)
4319 v1ij=v1(j,itori,itori1)
4320 v2ij=v2(j,itori,itori1)
4323 etors=etors+v1ij*cosphi+v2ij*sinphi
4324 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4328 C E = SUM ----------------------------------- - v1
4329 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4331 cosphi=dcos(0.5d0*phii)
4332 sinphi=dsin(0.5d0*phii)
4333 do j=1,nlor(itori,itori1)
4334 vl1ij=vlor1(j,itori,itori1)
4335 vl2ij=vlor2(j,itori,itori1)
4336 vl3ij=vlor3(j,itori,itori1)
4337 pom=vl2ij*cosphi+vl3ij*sinphi
4338 pom1=1.0d0/(pom*pom+1.0d0)
4339 etors=etors+vl1ij*pom1
4341 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4343 C Subtract the constant term
4344 etors=etors-v0(itori,itori1)
4346 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4347 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4348 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4349 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4350 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4353 ! 6/20/98 - dihedral angle constraints
4355 c write (iout,*) "Dihedral angle restraint energy"
4357 itori=idih_constr(i)
4359 difi=pinorm(phii-phi0(i))
4360 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
4361 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
4362 if (difi.gt.drange(i)) then
4364 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4365 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4366 c write (iout,*) 0.25d0*ftors*difi**4
4367 else if (difi.lt.-drange(i)) then
4369 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4370 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4371 c write (iout,*) 0.25d0*ftors*difi**4
4374 c write (iout,*) 'edihcnstr',edihcnstr
4377 c----------------------------------------------------------------------------
4378 subroutine etor_d(etors_d,fact2)
4379 C 6/23/01 Compute double torsional energy
4380 implicit real*8 (a-h,o-z)
4381 include 'DIMENSIONS'
4382 include 'sizesclu.dat'
4383 include 'COMMON.VAR'
4384 include 'COMMON.GEO'
4385 include 'COMMON.LOCAL'
4386 include 'COMMON.TORSION'
4387 include 'COMMON.INTERACT'
4388 include 'COMMON.DERIV'
4389 include 'COMMON.CHAIN'
4390 include 'COMMON.NAMES'
4391 include 'COMMON.IOUNITS'
4392 include 'COMMON.FFIELD'
4393 include 'COMMON.TORCNSTR'
4395 C Set lprn=.true. for debugging
4399 do i=iphi_start,iphi_end-1
4400 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4402 itori=itortyp(itype(i-2))
4403 itori1=itortyp(itype(i-1))
4404 itori2=itortyp(itype(i))
4409 C Regular cosine and sine terms
4410 do j=1,ntermd_1(itori,itori1,itori2)
4411 v1cij=v1c(1,j,itori,itori1,itori2)
4412 v1sij=v1s(1,j,itori,itori1,itori2)
4413 v2cij=v1c(2,j,itori,itori1,itori2)
4414 v2sij=v1s(2,j,itori,itori1,itori2)
4415 cosphi1=dcos(j*phii)
4416 sinphi1=dsin(j*phii)
4417 cosphi2=dcos(j*phii1)
4418 sinphi2=dsin(j*phii1)
4419 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4420 & v2cij*cosphi2+v2sij*sinphi2
4421 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4422 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4424 do k=2,ntermd_2(itori,itori1,itori2)
4426 v1cdij = v2c(k,l,itori,itori1,itori2)
4427 v2cdij = v2c(l,k,itori,itori1,itori2)
4428 v1sdij = v2s(k,l,itori,itori1,itori2)
4429 v2sdij = v2s(l,k,itori,itori1,itori2)
4430 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4431 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4432 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4433 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4434 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4435 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4436 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4437 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4438 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4439 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4442 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4443 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4449 c------------------------------------------------------------------------------
4450 subroutine eback_sc_corr(esccor,fact)
4451 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4452 c conformational states; temporarily implemented as differences
4453 c between UNRES torsional potentials (dependent on three types of
4454 c residues) and the torsional potentials dependent on all 20 types
4455 c of residues computed from AM1 energy surfaces of terminally-blocked
4456 c amino-acid residues.
4457 implicit real*8 (a-h,o-z)
4458 include 'DIMENSIONS'
4459 include 'COMMON.VAR'
4460 include 'COMMON.GEO'
4461 include 'COMMON.LOCAL'
4462 include 'COMMON.TORSION'
4463 include 'COMMON.SCCOR'
4464 include 'COMMON.INTERACT'
4465 include 'COMMON.DERIV'
4466 include 'COMMON.CHAIN'
4467 include 'COMMON.NAMES'
4468 include 'COMMON.IOUNITS'
4469 include 'COMMON.FFIELD'
4470 include 'COMMON.CONTROL'
4472 C Set lprn=.true. for debugging
4475 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4477 do i=itau_start,itau_end
4479 isccori=isccortyp(itype(i-2))
4480 isccori1=isccortyp(itype(i-1))
4482 cccc Added 9 May 2012
4483 cc Tauangle is torsional engle depending on the value of first digit
4484 c(see comment below)
4485 cc Omicron is flat angle depending on the value of first digit
4486 c(see comment below)
4489 do intertyp=1,3 !intertyp
4490 cc Added 09 May 2012 (Adasko)
4491 cc Intertyp means interaction type of backbone mainchain correlation:
4492 c 1 = SC...Ca...Ca...Ca
4493 c 2 = Ca...Ca...Ca...SC
4494 c 3 = SC...Ca...Ca...SCi
4496 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4497 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4498 & (itype(i-1).eq.21)))
4499 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4500 & .or.(itype(i-2).eq.21)))
4501 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4502 & (itype(i-1).eq.21)))) cycle
4503 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4504 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4506 do j=1,nterm_sccor(isccori,isccori1)
4507 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4508 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4509 cosphi=dcos(j*tauangle(intertyp,i))
4510 sinphi=dsin(j*tauangle(intertyp,i))
4511 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4513 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
4515 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4517 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4518 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4519 c &gloc_sc(intertyp,i-3,icg)
4521 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4522 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4523 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4524 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4525 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4531 c------------------------------------------------------------------------------
4532 subroutine multibody(ecorr)
4533 C This subroutine calculates multi-body contributions to energy following
4534 C the idea of Skolnick et al. If side chains I and J make a contact and
4535 C at the same time side chains I+1 and J+1 make a contact, an extra
4536 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4537 implicit real*8 (a-h,o-z)
4538 include 'DIMENSIONS'
4539 include 'COMMON.IOUNITS'
4540 include 'COMMON.DERIV'
4541 include 'COMMON.INTERACT'
4542 include 'COMMON.CONTACTS'
4543 double precision gx(3),gx1(3)
4546 C Set lprn=.true. for debugging
4550 write (iout,'(a)') 'Contact function values:'
4552 write (iout,'(i2,20(1x,i2,f10.5))')
4553 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4568 num_conti=num_cont(i)
4569 num_conti1=num_cont(i1)
4574 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4575 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4576 cd & ' ishift=',ishift
4577 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4578 C The system gains extra energy.
4579 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4580 endif ! j1==j+-ishift
4589 c------------------------------------------------------------------------------
4590 double precision function esccorr(i,j,k,l,jj,kk)
4591 implicit real*8 (a-h,o-z)
4592 include 'DIMENSIONS'
4593 include 'COMMON.IOUNITS'
4594 include 'COMMON.DERIV'
4595 include 'COMMON.INTERACT'
4596 include 'COMMON.CONTACTS'
4597 double precision gx(3),gx1(3)
4602 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4603 C Calculate the multi-body contribution to energy.
4604 C Calculate multi-body contributions to the gradient.
4605 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4606 cd & k,l,(gacont(m,kk,k),m=1,3)
4608 gx(m) =ekl*gacont(m,jj,i)
4609 gx1(m)=eij*gacont(m,kk,k)
4610 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4611 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4612 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4613 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4617 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4622 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4628 c------------------------------------------------------------------------------
4630 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4631 implicit real*8 (a-h,o-z)
4632 include 'DIMENSIONS'
4633 integer dimen1,dimen2,atom,indx
4634 double precision buffer(dimen1,dimen2)
4635 double precision zapas
4636 common /contacts_hb/ zapas(3,20,maxres,7),
4637 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4638 & num_cont_hb(maxres),jcont_hb(20,maxres)
4639 num_kont=num_cont_hb(atom)
4643 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4646 buffer(i,indx+22)=facont_hb(i,atom)
4647 buffer(i,indx+23)=ees0p(i,atom)
4648 buffer(i,indx+24)=ees0m(i,atom)
4649 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4651 buffer(1,indx+26)=dfloat(num_kont)
4654 c------------------------------------------------------------------------------
4655 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4656 implicit real*8 (a-h,o-z)
4657 include 'DIMENSIONS'
4658 integer dimen1,dimen2,atom,indx
4659 double precision buffer(dimen1,dimen2)
4660 double precision zapas
4661 common /contacts_hb/ zapas(3,20,maxres,7),
4662 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4663 & num_cont_hb(maxres),jcont_hb(20,maxres)
4664 num_kont=buffer(1,indx+26)
4665 num_kont_old=num_cont_hb(atom)
4666 num_cont_hb(atom)=num_kont+num_kont_old
4671 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4674 facont_hb(ii,atom)=buffer(i,indx+22)
4675 ees0p(ii,atom)=buffer(i,indx+23)
4676 ees0m(ii,atom)=buffer(i,indx+24)
4677 jcont_hb(ii,atom)=buffer(i,indx+25)
4681 c------------------------------------------------------------------------------
4683 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4684 C This subroutine calculates multi-body contributions to hydrogen-bonding
4685 implicit real*8 (a-h,o-z)
4686 include 'DIMENSIONS'
4687 include 'sizesclu.dat'
4688 include 'COMMON.IOUNITS'
4690 include 'COMMON.INFO'
4692 include 'COMMON.FFIELD'
4693 include 'COMMON.DERIV'
4694 include 'COMMON.INTERACT'
4695 include 'COMMON.CONTACTS'
4697 parameter (max_cont=maxconts)
4698 parameter (max_dim=2*(8*3+2))
4699 parameter (msglen1=max_cont*max_dim*4)
4700 parameter (msglen2=2*msglen1)
4701 integer source,CorrelType,CorrelID,Error
4702 double precision buffer(max_cont,max_dim)
4704 double precision gx(3),gx1(3)
4707 C Set lprn=.true. for debugging
4712 if (fgProcs.le.1) goto 30
4714 write (iout,'(a)') 'Contact function values:'
4716 write (iout,'(2i3,50(1x,i2,f5.2))')
4717 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4718 & j=1,num_cont_hb(i))
4721 C Caution! Following code assumes that electrostatic interactions concerning
4722 C a given atom are split among at most two processors!
4732 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4735 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4736 if (MyRank.gt.0) then
4737 C Send correlation contributions to the preceding processor
4739 nn=num_cont_hb(iatel_s)
4740 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4741 cd write (iout,*) 'The BUFFER array:'
4743 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4745 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4747 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4748 C Clear the contacts of the atom passed to the neighboring processor
4749 nn=num_cont_hb(iatel_s+1)
4751 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4753 num_cont_hb(iatel_s)=0
4755 cd write (iout,*) 'Processor ',MyID,MyRank,
4756 cd & ' is sending correlation contribution to processor',MyID-1,
4757 cd & ' msglen=',msglen
4758 cd write (*,*) 'Processor ',MyID,MyRank,
4759 cd & ' is sending correlation contribution to processor',MyID-1,
4760 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4761 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4762 cd write (iout,*) 'Processor ',MyID,
4763 cd & ' has sent correlation contribution to processor',MyID-1,
4764 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4765 cd write (*,*) 'Processor ',MyID,
4766 cd & ' has sent correlation contribution to processor',MyID-1,
4767 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4769 endif ! (MyRank.gt.0)
4773 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4774 if (MyRank.lt.fgProcs-1) then
4775 C Receive correlation contributions from the next processor
4777 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4778 cd write (iout,*) 'Processor',MyID,
4779 cd & ' is receiving correlation contribution from processor',MyID+1,
4780 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4781 cd write (*,*) 'Processor',MyID,
4782 cd & ' is receiving correlation contribution from processor',MyID+1,
4783 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4785 do while (nbytes.le.0)
4786 call mp_probe(MyID+1,CorrelType,nbytes)
4788 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4789 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4790 cd write (iout,*) 'Processor',MyID,
4791 cd & ' has received correlation contribution from processor',MyID+1,
4792 cd & ' msglen=',msglen,' nbytes=',nbytes
4793 cd write (iout,*) 'The received BUFFER array:'
4795 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4797 if (msglen.eq.msglen1) then
4798 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4799 else if (msglen.eq.msglen2) then
4800 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4801 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4804 & 'ERROR!!!! message length changed while processing correlations.'
4806 & 'ERROR!!!! message length changed while processing correlations.'
4807 call mp_stopall(Error)
4808 endif ! msglen.eq.msglen1
4809 endif ! MyRank.lt.fgProcs-1
4816 write (iout,'(a)') 'Contact function values:'
4818 write (iout,'(2i3,50(1x,i2,f5.2))')
4819 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4820 & j=1,num_cont_hb(i))
4824 C Remove the loop below after debugging !!!
4831 C Calculate the local-electrostatic correlation terms
4832 do i=iatel_s,iatel_e+1
4834 num_conti=num_cont_hb(i)
4835 num_conti1=num_cont_hb(i+1)
4840 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4841 c & ' jj=',jj,' kk=',kk
4842 if (j1.eq.j+1 .or. j1.eq.j-1) then
4843 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4844 C The system gains extra energy.
4845 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4847 else if (j1.eq.j) then
4848 C Contacts I-J and I-(J+1) occur simultaneously.
4849 C The system loses extra energy.
4850 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4855 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4856 c & ' jj=',jj,' kk=',kk
4858 C Contacts I-J and (I+1)-J occur simultaneously.
4859 C The system loses extra energy.
4860 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4867 c------------------------------------------------------------------------------
4868 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4870 C This subroutine calculates multi-body contributions to hydrogen-bonding
4871 implicit real*8 (a-h,o-z)
4872 include 'DIMENSIONS'
4873 include 'sizesclu.dat'
4874 include 'COMMON.IOUNITS'
4876 include 'COMMON.INFO'
4878 include 'COMMON.FFIELD'
4879 include 'COMMON.DERIV'
4880 include 'COMMON.INTERACT'
4881 include 'COMMON.CONTACTS'
4883 parameter (max_cont=maxconts)
4884 parameter (max_dim=2*(8*3+2))
4885 parameter (msglen1=max_cont*max_dim*4)
4886 parameter (msglen2=2*msglen1)
4887 integer source,CorrelType,CorrelID,Error
4888 double precision buffer(max_cont,max_dim)
4890 double precision gx(3),gx1(3)
4893 C Set lprn=.true. for debugging
4900 if (fgProcs.le.1) goto 30
4902 write (iout,'(a)') 'Contact function values:'
4904 write (iout,'(2i3,50(1x,i2,f5.2))')
4905 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4906 & j=1,num_cont_hb(i))
4909 C Caution! Following code assumes that electrostatic interactions concerning
4910 C a given atom are split among at most two processors!
4920 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4923 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4924 if (MyRank.gt.0) then
4925 C Send correlation contributions to the preceding processor
4927 nn=num_cont_hb(iatel_s)
4928 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4929 cd write (iout,*) 'The BUFFER array:'
4931 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4933 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4935 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4936 C Clear the contacts of the atom passed to the neighboring processor
4937 nn=num_cont_hb(iatel_s+1)
4939 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4941 num_cont_hb(iatel_s)=0
4943 cd write (iout,*) 'Processor ',MyID,MyRank,
4944 cd & ' is sending correlation contribution to processor',MyID-1,
4945 cd & ' msglen=',msglen
4946 cd write (*,*) 'Processor ',MyID,MyRank,
4947 cd & ' is sending correlation contribution to processor',MyID-1,
4948 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4949 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4950 cd write (iout,*) 'Processor ',MyID,
4951 cd & ' has sent correlation contribution to processor',MyID-1,
4952 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4953 cd write (*,*) 'Processor ',MyID,
4954 cd & ' has sent correlation contribution to processor',MyID-1,
4955 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4957 endif ! (MyRank.gt.0)
4961 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4962 if (MyRank.lt.fgProcs-1) then
4963 C Receive correlation contributions from the next processor
4965 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4966 cd write (iout,*) 'Processor',MyID,
4967 cd & ' is receiving correlation contribution from processor',MyID+1,
4968 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4969 cd write (*,*) 'Processor',MyID,
4970 cd & ' is receiving correlation contribution from processor',MyID+1,
4971 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4973 do while (nbytes.le.0)
4974 call mp_probe(MyID+1,CorrelType,nbytes)
4976 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4977 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4978 cd write (iout,*) 'Processor',MyID,
4979 cd & ' has received correlation contribution from processor',MyID+1,
4980 cd & ' msglen=',msglen,' nbytes=',nbytes
4981 cd write (iout,*) 'The received BUFFER array:'
4983 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4985 if (msglen.eq.msglen1) then
4986 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4987 else if (msglen.eq.msglen2) then
4988 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4989 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4992 & 'ERROR!!!! message length changed while processing correlations.'
4994 & 'ERROR!!!! message length changed while processing correlations.'
4995 call mp_stopall(Error)
4996 endif ! msglen.eq.msglen1
4997 endif ! MyRank.lt.fgProcs-1
5004 write (iout,'(a)') 'Contact function values:'
5006 write (iout,'(2i3,50(1x,i2,f5.2))')
5007 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5008 & j=1,num_cont_hb(i))
5014 C Remove the loop below after debugging !!!
5021 C Calculate the dipole-dipole interaction energies
5022 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5023 do i=iatel_s,iatel_e+1
5024 num_conti=num_cont_hb(i)
5031 C Calculate the local-electrostatic correlation terms
5032 do i=iatel_s,iatel_e+1
5034 num_conti=num_cont_hb(i)
5035 num_conti1=num_cont_hb(i+1)
5040 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5041 c & ' jj=',jj,' kk=',kk
5042 if (j1.eq.j+1 .or. j1.eq.j-1) then
5043 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5044 C The system gains extra energy.
5046 sqd1=dsqrt(d_cont(jj,i))
5047 sqd2=dsqrt(d_cont(kk,i1))
5048 sred_geom = sqd1*sqd2
5049 IF (sred_geom.lt.cutoff_corr) THEN
5050 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5052 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5053 c & ' jj=',jj,' kk=',kk
5054 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5055 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5057 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5058 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5061 cd write (iout,*) 'sred_geom=',sred_geom,
5062 cd & ' ekont=',ekont,' fprim=',fprimcont
5063 call calc_eello(i,j,i+1,j1,jj,kk)
5064 if (wcorr4.gt.0.0d0)
5065 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5066 if (wcorr5.gt.0.0d0)
5067 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5068 c print *,"wcorr5",ecorr5
5069 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5070 cd write(2,*)'ijkl',i,j,i+1,j1
5071 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5072 & .or. wturn6.eq.0.0d0))then
5073 c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5074 c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5075 c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5076 c & 'ecorr6=',ecorr6, wcorr6
5077 cd write (iout,'(4e15.5)') sred_geom,
5078 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5079 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5080 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5081 else if (wturn6.gt.0.0d0
5082 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5083 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5084 eturn6=eturn6+eello_turn6(i,jj,kk)
5085 cd write (2,*) 'multibody_eello:eturn6',eturn6
5089 else if (j1.eq.j) then
5090 C Contacts I-J and I-(J+1) occur simultaneously.
5091 C The system loses extra energy.
5092 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5097 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5098 c & ' jj=',jj,' kk=',kk
5100 C Contacts I-J and (I+1)-J occur simultaneously.
5101 C The system loses extra energy.
5102 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5109 c------------------------------------------------------------------------------
5110 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5111 implicit real*8 (a-h,o-z)
5112 include 'DIMENSIONS'
5113 include 'COMMON.IOUNITS'
5114 include 'COMMON.DERIV'
5115 include 'COMMON.INTERACT'
5116 include 'COMMON.CONTACTS'
5117 double precision gx(3),gx1(3)
5127 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5128 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5129 C Following 4 lines for diagnostics.
5134 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5136 c write (iout,*)'Contacts have occurred for peptide groups',
5137 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5138 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5139 C Calculate the multi-body contribution to energy.
5140 ecorr=ecorr+ekont*ees
5142 C Calculate multi-body contributions to the gradient.
5144 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5145 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5146 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5147 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5148 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5149 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5150 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5151 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5152 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5153 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5154 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5155 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5156 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5157 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5161 gradcorr(ll,m)=gradcorr(ll,m)+
5162 & ees*ekl*gacont_hbr(ll,jj,i)-
5163 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5164 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5169 gradcorr(ll,m)=gradcorr(ll,m)+
5170 & ees*eij*gacont_hbr(ll,kk,k)-
5171 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5172 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5179 C---------------------------------------------------------------------------
5180 subroutine dipole(i,j,jj)
5181 implicit real*8 (a-h,o-z)
5182 include 'DIMENSIONS'
5183 include 'sizesclu.dat'
5184 include 'COMMON.IOUNITS'
5185 include 'COMMON.CHAIN'
5186 include 'COMMON.FFIELD'
5187 include 'COMMON.DERIV'
5188 include 'COMMON.INTERACT'
5189 include 'COMMON.CONTACTS'
5190 include 'COMMON.TORSION'
5191 include 'COMMON.VAR'
5192 include 'COMMON.GEO'
5193 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5195 iti1 = itortyp(itype(i+1))
5196 if (j.lt.nres-1) then
5197 itj1 = itortyp(itype(j+1))
5202 dipi(iii,1)=Ub2(iii,i)
5203 dipderi(iii)=Ub2der(iii,i)
5204 dipi(iii,2)=b1(iii,iti1)
5205 dipj(iii,1)=Ub2(iii,j)
5206 dipderj(iii)=Ub2der(iii,j)
5207 dipj(iii,2)=b1(iii,itj1)
5211 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5214 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5217 if (.not.calc_grad) return
5222 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5226 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5231 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5232 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5234 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5236 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5238 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5242 C---------------------------------------------------------------------------
5243 subroutine calc_eello(i,j,k,l,jj,kk)
5245 C This subroutine computes matrices and vectors needed to calculate
5246 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5248 implicit real*8 (a-h,o-z)
5249 include 'DIMENSIONS'
5250 include 'sizesclu.dat'
5251 include 'COMMON.IOUNITS'
5252 include 'COMMON.CHAIN'
5253 include 'COMMON.DERIV'
5254 include 'COMMON.INTERACT'
5255 include 'COMMON.CONTACTS'
5256 include 'COMMON.TORSION'
5257 include 'COMMON.VAR'
5258 include 'COMMON.GEO'
5259 include 'COMMON.FFIELD'
5260 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5261 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5264 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5265 cd & ' jj=',jj,' kk=',kk
5266 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5269 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5270 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5273 call transpose2(aa1(1,1),aa1t(1,1))
5274 call transpose2(aa2(1,1),aa2t(1,1))
5277 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5278 & aa1tder(1,1,lll,kkk))
5279 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5280 & aa2tder(1,1,lll,kkk))
5284 C parallel orientation of the two CA-CA-CA frames.
5286 iti=itortyp(itype(i))
5290 itk1=itortyp(itype(k+1))
5291 itj=itortyp(itype(j))
5292 if (l.lt.nres-1) then
5293 itl1=itortyp(itype(l+1))
5297 C A1 kernel(j+1) A2T
5299 cd write (iout,'(3f10.5,5x,3f10.5)')
5300 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5302 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5303 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5304 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5305 C Following matrices are needed only for 6-th order cumulants
5306 IF (wcorr6.gt.0.0d0) THEN
5307 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5308 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5309 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5310 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5311 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5312 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5313 & ADtEAderx(1,1,1,1,1,1))
5315 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5316 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5317 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5318 & ADtEA1derx(1,1,1,1,1,1))
5320 C End 6-th order cumulants
5323 cd write (2,*) 'In calc_eello6'
5325 cd write (2,*) 'iii=',iii
5327 cd write (2,*) 'kkk=',kkk
5329 cd write (2,'(3(2f10.5),5x)')
5330 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5335 call transpose2(EUgder(1,1,k),auxmat(1,1))
5336 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5337 call transpose2(EUg(1,1,k),auxmat(1,1))
5338 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5339 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5343 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5344 & EAEAderx(1,1,lll,kkk,iii,1))
5348 C A1T kernel(i+1) A2
5349 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5350 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5351 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5352 C Following matrices are needed only for 6-th order cumulants
5353 IF (wcorr6.gt.0.0d0) THEN
5354 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5355 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5356 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5357 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5358 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5359 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5360 & ADtEAderx(1,1,1,1,1,2))
5361 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5362 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5363 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5364 & ADtEA1derx(1,1,1,1,1,2))
5366 C End 6-th order cumulants
5367 call transpose2(EUgder(1,1,l),auxmat(1,1))
5368 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5369 call transpose2(EUg(1,1,l),auxmat(1,1))
5370 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5371 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5375 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5376 & EAEAderx(1,1,lll,kkk,iii,2))
5381 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5382 C They are needed only when the fifth- or the sixth-order cumulants are
5384 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5385 call transpose2(AEA(1,1,1),auxmat(1,1))
5386 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5387 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5388 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5389 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5390 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5391 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5392 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5393 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5394 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5395 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5396 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5397 call transpose2(AEA(1,1,2),auxmat(1,1))
5398 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5399 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5400 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5401 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5402 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5403 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5404 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5405 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5406 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5407 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5408 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5409 C Calculate the Cartesian derivatives of the vectors.
5413 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5414 call matvec2(auxmat(1,1),b1(1,iti),
5415 & AEAb1derx(1,lll,kkk,iii,1,1))
5416 call matvec2(auxmat(1,1),Ub2(1,i),
5417 & AEAb2derx(1,lll,kkk,iii,1,1))
5418 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5419 & AEAb1derx(1,lll,kkk,iii,2,1))
5420 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5421 & AEAb2derx(1,lll,kkk,iii,2,1))
5422 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5423 call matvec2(auxmat(1,1),b1(1,itj),
5424 & AEAb1derx(1,lll,kkk,iii,1,2))
5425 call matvec2(auxmat(1,1),Ub2(1,j),
5426 & AEAb2derx(1,lll,kkk,iii,1,2))
5427 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5428 & AEAb1derx(1,lll,kkk,iii,2,2))
5429 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5430 & AEAb2derx(1,lll,kkk,iii,2,2))
5437 C Antiparallel orientation of the two CA-CA-CA frames.
5439 iti=itortyp(itype(i))
5443 itk1=itortyp(itype(k+1))
5444 itl=itortyp(itype(l))
5445 itj=itortyp(itype(j))
5446 if (j.lt.nres-1) then
5447 itj1=itortyp(itype(j+1))
5451 C A2 kernel(j-1)T A1T
5452 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5453 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5454 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5455 C Following matrices are needed only for 6-th order cumulants
5456 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5457 & j.eq.i+4 .and. l.eq.i+3)) THEN
5458 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5459 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5460 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5461 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5462 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5463 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5464 & ADtEAderx(1,1,1,1,1,1))
5465 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5466 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5467 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5468 & ADtEA1derx(1,1,1,1,1,1))
5470 C End 6-th order cumulants
5471 call transpose2(EUgder(1,1,k),auxmat(1,1))
5472 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5473 call transpose2(EUg(1,1,k),auxmat(1,1))
5474 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5475 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5479 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5480 & EAEAderx(1,1,lll,kkk,iii,1))
5484 C A2T kernel(i+1)T A1
5485 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5486 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5487 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5488 C Following matrices are needed only for 6-th order cumulants
5489 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5490 & j.eq.i+4 .and. l.eq.i+3)) THEN
5491 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5492 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5493 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5494 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5495 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5496 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5497 & ADtEAderx(1,1,1,1,1,2))
5498 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5499 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5500 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5501 & ADtEA1derx(1,1,1,1,1,2))
5503 C End 6-th order cumulants
5504 call transpose2(EUgder(1,1,j),auxmat(1,1))
5505 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5506 call transpose2(EUg(1,1,j),auxmat(1,1))
5507 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5508 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5512 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5513 & EAEAderx(1,1,lll,kkk,iii,2))
5518 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5519 C They are needed only when the fifth- or the sixth-order cumulants are
5521 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5522 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5523 call transpose2(AEA(1,1,1),auxmat(1,1))
5524 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5525 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5526 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5527 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5528 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5529 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5530 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5531 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5532 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5533 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5534 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5535 call transpose2(AEA(1,1,2),auxmat(1,1))
5536 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5537 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5538 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5539 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5540 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5541 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5542 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5543 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5544 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5545 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5546 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5547 C Calculate the Cartesian derivatives of the vectors.
5551 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5552 call matvec2(auxmat(1,1),b1(1,iti),
5553 & AEAb1derx(1,lll,kkk,iii,1,1))
5554 call matvec2(auxmat(1,1),Ub2(1,i),
5555 & AEAb2derx(1,lll,kkk,iii,1,1))
5556 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5557 & AEAb1derx(1,lll,kkk,iii,2,1))
5558 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5559 & AEAb2derx(1,lll,kkk,iii,2,1))
5560 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5561 call matvec2(auxmat(1,1),b1(1,itl),
5562 & AEAb1derx(1,lll,kkk,iii,1,2))
5563 call matvec2(auxmat(1,1),Ub2(1,l),
5564 & AEAb2derx(1,lll,kkk,iii,1,2))
5565 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5566 & AEAb1derx(1,lll,kkk,iii,2,2))
5567 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5568 & AEAb2derx(1,lll,kkk,iii,2,2))
5577 C---------------------------------------------------------------------------
5578 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5579 & KK,KKderg,AKA,AKAderg,AKAderx)
5583 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5584 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5585 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5590 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5592 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5595 cd if (lprn) write (2,*) 'In kernel'
5597 cd if (lprn) write (2,*) 'kkk=',kkk
5599 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5600 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5602 cd write (2,*) 'lll=',lll
5603 cd write (2,*) 'iii=1'
5605 cd write (2,'(3(2f10.5),5x)')
5606 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5609 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5610 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5612 cd write (2,*) 'lll=',lll
5613 cd write (2,*) 'iii=2'
5615 cd write (2,'(3(2f10.5),5x)')
5616 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5623 C---------------------------------------------------------------------------
5624 double precision function eello4(i,j,k,l,jj,kk)
5625 implicit real*8 (a-h,o-z)
5626 include 'DIMENSIONS'
5627 include 'sizesclu.dat'
5628 include 'COMMON.IOUNITS'
5629 include 'COMMON.CHAIN'
5630 include 'COMMON.DERIV'
5631 include 'COMMON.INTERACT'
5632 include 'COMMON.CONTACTS'
5633 include 'COMMON.TORSION'
5634 include 'COMMON.VAR'
5635 include 'COMMON.GEO'
5636 double precision pizda(2,2),ggg1(3),ggg2(3)
5637 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5641 cd print *,'eello4:',i,j,k,l,jj,kk
5642 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5643 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5644 cold eij=facont_hb(jj,i)
5645 cold ekl=facont_hb(kk,k)
5647 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5649 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5650 gcorr_loc(k-1)=gcorr_loc(k-1)
5651 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5653 gcorr_loc(l-1)=gcorr_loc(l-1)
5654 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5656 gcorr_loc(j-1)=gcorr_loc(j-1)
5657 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5662 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5663 & -EAEAderx(2,2,lll,kkk,iii,1)
5664 cd derx(lll,kkk,iii)=0.0d0
5668 cd gcorr_loc(l-1)=0.0d0
5669 cd gcorr_loc(j-1)=0.0d0
5670 cd gcorr_loc(k-1)=0.0d0
5672 cd write (iout,*)'Contacts have occurred for peptide groups',
5673 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5674 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5675 if (j.lt.nres-1) then
5682 if (l.lt.nres-1) then
5690 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5691 ggg1(ll)=eel4*g_contij(ll,1)
5692 ggg2(ll)=eel4*g_contij(ll,2)
5693 ghalf=0.5d0*ggg1(ll)
5695 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5696 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5697 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5698 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5699 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5700 ghalf=0.5d0*ggg2(ll)
5702 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5703 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5704 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5705 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5710 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5711 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5716 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5717 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5723 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5728 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5732 cd write (2,*) iii,gcorr_loc(iii)
5736 cd write (2,*) 'ekont',ekont
5737 cd write (iout,*) 'eello4',ekont*eel4
5740 C---------------------------------------------------------------------------
5741 double precision function eello5(i,j,k,l,jj,kk)
5742 implicit real*8 (a-h,o-z)
5743 include 'DIMENSIONS'
5744 include 'sizesclu.dat'
5745 include 'COMMON.IOUNITS'
5746 include 'COMMON.CHAIN'
5747 include 'COMMON.DERIV'
5748 include 'COMMON.INTERACT'
5749 include 'COMMON.CONTACTS'
5750 include 'COMMON.TORSION'
5751 include 'COMMON.VAR'
5752 include 'COMMON.GEO'
5753 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5754 double precision ggg1(3),ggg2(3)
5755 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5760 C /l\ / \ \ / \ / \ / C
5761 C / \ / \ \ / \ / \ / C
5762 C j| o |l1 | o | o| o | | o |o C
5763 C \ |/k\| |/ \| / |/ \| |/ \| C
5764 C \i/ \ / \ / / \ / \ C
5766 C (I) (II) (III) (IV) C
5768 C eello5_1 eello5_2 eello5_3 eello5_4 C
5770 C Antiparallel chains C
5773 C /j\ / \ \ / \ / \ / C
5774 C / \ / \ \ / \ / \ / C
5775 C j1| o |l | o | o| o | | o |o C
5776 C \ |/k\| |/ \| / |/ \| |/ \| C
5777 C \i/ \ / \ / / \ / \ C
5779 C (I) (II) (III) (IV) C
5781 C eello5_1 eello5_2 eello5_3 eello5_4 C
5783 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5785 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5786 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5791 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5793 itk=itortyp(itype(k))
5794 itl=itortyp(itype(l))
5795 itj=itortyp(itype(j))
5800 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5801 cd & eel5_3_num,eel5_4_num)
5805 derx(lll,kkk,iii)=0.0d0
5809 cd eij=facont_hb(jj,i)
5810 cd ekl=facont_hb(kk,k)
5812 cd write (iout,*)'Contacts have occurred for peptide groups',
5813 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5815 C Contribution from the graph I.
5816 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5817 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5818 call transpose2(EUg(1,1,k),auxmat(1,1))
5819 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5820 vv(1)=pizda(1,1)-pizda(2,2)
5821 vv(2)=pizda(1,2)+pizda(2,1)
5822 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5823 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5825 C Explicit gradient in virtual-dihedral angles.
5826 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5827 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5828 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5829 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5830 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5831 vv(1)=pizda(1,1)-pizda(2,2)
5832 vv(2)=pizda(1,2)+pizda(2,1)
5833 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5834 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5835 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5836 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5837 vv(1)=pizda(1,1)-pizda(2,2)
5838 vv(2)=pizda(1,2)+pizda(2,1)
5840 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5841 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5842 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5844 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5845 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5846 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5848 C Cartesian gradient
5852 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5854 vv(1)=pizda(1,1)-pizda(2,2)
5855 vv(2)=pizda(1,2)+pizda(2,1)
5856 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5857 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5858 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5865 C Contribution from graph II
5866 call transpose2(EE(1,1,itk),auxmat(1,1))
5867 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5868 vv(1)=pizda(1,1)+pizda(2,2)
5869 vv(2)=pizda(2,1)-pizda(1,2)
5870 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5871 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5873 C Explicit gradient in virtual-dihedral angles.
5874 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5875 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5876 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5877 vv(1)=pizda(1,1)+pizda(2,2)
5878 vv(2)=pizda(2,1)-pizda(1,2)
5880 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5881 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5882 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5884 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5885 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5886 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5888 C Cartesian gradient
5892 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5894 vv(1)=pizda(1,1)+pizda(2,2)
5895 vv(2)=pizda(2,1)-pizda(1,2)
5896 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5897 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5898 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5907 C Parallel orientation
5908 C Contribution from graph III
5909 call transpose2(EUg(1,1,l),auxmat(1,1))
5910 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5911 vv(1)=pizda(1,1)-pizda(2,2)
5912 vv(2)=pizda(1,2)+pizda(2,1)
5913 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5914 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5916 C Explicit gradient in virtual-dihedral angles.
5917 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5918 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5919 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5920 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5921 vv(1)=pizda(1,1)-pizda(2,2)
5922 vv(2)=pizda(1,2)+pizda(2,1)
5923 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5924 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5925 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5926 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5927 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5928 vv(1)=pizda(1,1)-pizda(2,2)
5929 vv(2)=pizda(1,2)+pizda(2,1)
5930 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5931 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5932 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5933 C Cartesian gradient
5937 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5939 vv(1)=pizda(1,1)-pizda(2,2)
5940 vv(2)=pizda(1,2)+pizda(2,1)
5941 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5942 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5943 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5949 C Contribution from graph IV
5951 call transpose2(EE(1,1,itl),auxmat(1,1))
5952 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5953 vv(1)=pizda(1,1)+pizda(2,2)
5954 vv(2)=pizda(2,1)-pizda(1,2)
5955 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5956 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5958 C Explicit gradient in virtual-dihedral angles.
5959 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5960 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5961 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5962 vv(1)=pizda(1,1)+pizda(2,2)
5963 vv(2)=pizda(2,1)-pizda(1,2)
5964 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5965 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5966 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5967 C Cartesian gradient
5971 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5973 vv(1)=pizda(1,1)+pizda(2,2)
5974 vv(2)=pizda(2,1)-pizda(1,2)
5975 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5976 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5977 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5983 C Antiparallel orientation
5984 C Contribution from graph III
5986 call transpose2(EUg(1,1,j),auxmat(1,1))
5987 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5988 vv(1)=pizda(1,1)-pizda(2,2)
5989 vv(2)=pizda(1,2)+pizda(2,1)
5990 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
5991 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5993 C Explicit gradient in virtual-dihedral angles.
5994 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5995 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
5996 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
5997 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5998 vv(1)=pizda(1,1)-pizda(2,2)
5999 vv(2)=pizda(1,2)+pizda(2,1)
6000 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6001 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6002 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6003 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6004 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6005 vv(1)=pizda(1,1)-pizda(2,2)
6006 vv(2)=pizda(1,2)+pizda(2,1)
6007 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6008 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6009 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6010 C Cartesian gradient
6014 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6016 vv(1)=pizda(1,1)-pizda(2,2)
6017 vv(2)=pizda(1,2)+pizda(2,1)
6018 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6019 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6020 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6026 C Contribution from graph IV
6028 call transpose2(EE(1,1,itj),auxmat(1,1))
6029 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6030 vv(1)=pizda(1,1)+pizda(2,2)
6031 vv(2)=pizda(2,1)-pizda(1,2)
6032 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6033 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6035 C Explicit gradient in virtual-dihedral angles.
6036 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6037 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6038 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6039 vv(1)=pizda(1,1)+pizda(2,2)
6040 vv(2)=pizda(2,1)-pizda(1,2)
6041 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6042 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6043 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6044 C Cartesian gradient
6048 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6050 vv(1)=pizda(1,1)+pizda(2,2)
6051 vv(2)=pizda(2,1)-pizda(1,2)
6052 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6053 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6054 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6061 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6062 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6063 cd write (2,*) 'ijkl',i,j,k,l
6064 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6065 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6067 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6068 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6069 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6070 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6072 if (j.lt.nres-1) then
6079 if (l.lt.nres-1) then
6089 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6091 ggg1(ll)=eel5*g_contij(ll,1)
6092 ggg2(ll)=eel5*g_contij(ll,2)
6093 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6094 ghalf=0.5d0*ggg1(ll)
6096 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6097 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6098 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6099 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6100 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6101 ghalf=0.5d0*ggg2(ll)
6103 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6104 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6105 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6106 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6111 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6112 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6117 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6118 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6124 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6129 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6133 cd write (2,*) iii,g_corr5_loc(iii)
6137 cd write (2,*) 'ekont',ekont
6138 cd write (iout,*) 'eello5',ekont*eel5
6141 c--------------------------------------------------------------------------
6142 double precision function eello6(i,j,k,l,jj,kk)
6143 implicit real*8 (a-h,o-z)
6144 include 'DIMENSIONS'
6145 include 'sizesclu.dat'
6146 include 'COMMON.IOUNITS'
6147 include 'COMMON.CHAIN'
6148 include 'COMMON.DERIV'
6149 include 'COMMON.INTERACT'
6150 include 'COMMON.CONTACTS'
6151 include 'COMMON.TORSION'
6152 include 'COMMON.VAR'
6153 include 'COMMON.GEO'
6154 include 'COMMON.FFIELD'
6155 double precision ggg1(3),ggg2(3)
6156 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6161 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6169 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6170 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6174 derx(lll,kkk,iii)=0.0d0
6178 cd eij=facont_hb(jj,i)
6179 cd ekl=facont_hb(kk,k)
6185 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6186 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6187 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6188 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6189 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6190 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6192 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6193 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6194 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6195 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6196 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6197 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6201 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6203 C If turn contributions are considered, they will be handled separately.
6204 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6205 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6206 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6207 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6208 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6209 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6210 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6213 if (j.lt.nres-1) then
6220 if (l.lt.nres-1) then
6228 ggg1(ll)=eel6*g_contij(ll,1)
6229 ggg2(ll)=eel6*g_contij(ll,2)
6230 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6231 ghalf=0.5d0*ggg1(ll)
6233 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6234 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6235 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6236 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6237 ghalf=0.5d0*ggg2(ll)
6238 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6240 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6241 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6242 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6243 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6248 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6249 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6254 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6255 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6261 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6266 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6270 cd write (2,*) iii,g_corr6_loc(iii)
6274 cd write (2,*) 'ekont',ekont
6275 cd write (iout,*) 'eello6',ekont*eel6
6278 c--------------------------------------------------------------------------
6279 double precision function eello6_graph1(i,j,k,l,imat,swap)
6280 implicit real*8 (a-h,o-z)
6281 include 'DIMENSIONS'
6282 include 'sizesclu.dat'
6283 include 'COMMON.IOUNITS'
6284 include 'COMMON.CHAIN'
6285 include 'COMMON.DERIV'
6286 include 'COMMON.INTERACT'
6287 include 'COMMON.CONTACTS'
6288 include 'COMMON.TORSION'
6289 include 'COMMON.VAR'
6290 include 'COMMON.GEO'
6291 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6295 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6297 C Parallel Antiparallel C
6303 C \ j|/k\| / \ |/k\|l / C
6308 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6309 itk=itortyp(itype(k))
6310 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6311 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6312 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6313 call transpose2(EUgC(1,1,k),auxmat(1,1))
6314 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6315 vv1(1)=pizda1(1,1)-pizda1(2,2)
6316 vv1(2)=pizda1(1,2)+pizda1(2,1)
6317 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6318 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6319 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6320 s5=scalar2(vv(1),Dtobr2(1,i))
6321 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6322 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6323 if (.not. calc_grad) return
6324 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6325 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6326 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6327 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6328 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6329 & +scalar2(vv(1),Dtobr2der(1,i)))
6330 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6331 vv1(1)=pizda1(1,1)-pizda1(2,2)
6332 vv1(2)=pizda1(1,2)+pizda1(2,1)
6333 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6334 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6336 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6337 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6338 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6339 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6340 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6342 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6343 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6344 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6345 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6346 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6348 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6349 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6350 vv1(1)=pizda1(1,1)-pizda1(2,2)
6351 vv1(2)=pizda1(1,2)+pizda1(2,1)
6352 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6353 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6354 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6355 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6364 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6365 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6366 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6367 call transpose2(EUgC(1,1,k),auxmat(1,1))
6368 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6370 vv1(1)=pizda1(1,1)-pizda1(2,2)
6371 vv1(2)=pizda1(1,2)+pizda1(2,1)
6372 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6373 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6374 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6375 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6376 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6377 s5=scalar2(vv(1),Dtobr2(1,i))
6378 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6384 c----------------------------------------------------------------------------
6385 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6386 implicit real*8 (a-h,o-z)
6387 include 'DIMENSIONS'
6388 include 'sizesclu.dat'
6389 include 'COMMON.IOUNITS'
6390 include 'COMMON.CHAIN'
6391 include 'COMMON.DERIV'
6392 include 'COMMON.INTERACT'
6393 include 'COMMON.CONTACTS'
6394 include 'COMMON.TORSION'
6395 include 'COMMON.VAR'
6396 include 'COMMON.GEO'
6398 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6399 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6402 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6404 C Parallel Antiparallel C
6410 C \ j|/k\| \ |/k\|l C
6415 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6416 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6417 C AL 7/4/01 s1 would occur in the sixth-order moment,
6418 C but not in a cluster cumulant
6420 s1=dip(1,jj,i)*dip(1,kk,k)
6422 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6423 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6424 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6425 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6426 call transpose2(EUg(1,1,k),auxmat(1,1))
6427 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6428 vv(1)=pizda(1,1)-pizda(2,2)
6429 vv(2)=pizda(1,2)+pizda(2,1)
6430 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6431 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6433 eello6_graph2=-(s1+s2+s3+s4)
6435 eello6_graph2=-(s2+s3+s4)
6438 if (.not. calc_grad) return
6439 C Derivatives in gamma(i-1)
6442 s1=dipderg(1,jj,i)*dip(1,kk,k)
6444 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6445 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6446 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6447 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6449 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6451 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6453 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6455 C Derivatives in gamma(k-1)
6457 s1=dip(1,jj,i)*dipderg(1,kk,k)
6459 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6460 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6461 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6462 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6463 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6464 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6465 vv(1)=pizda(1,1)-pizda(2,2)
6466 vv(2)=pizda(1,2)+pizda(2,1)
6467 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6469 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6471 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6473 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6474 C Derivatives in gamma(j-1) or gamma(l-1)
6477 s1=dipderg(3,jj,i)*dip(1,kk,k)
6479 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6480 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6481 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6482 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6483 vv(1)=pizda(1,1)-pizda(2,2)
6484 vv(2)=pizda(1,2)+pizda(2,1)
6485 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6488 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6490 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6493 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6494 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6496 C Derivatives in gamma(l-1) or gamma(j-1)
6499 s1=dip(1,jj,i)*dipderg(3,kk,k)
6501 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6502 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6503 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6504 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6505 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6506 vv(1)=pizda(1,1)-pizda(2,2)
6507 vv(2)=pizda(1,2)+pizda(2,1)
6508 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6511 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6513 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6516 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6517 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6519 C Cartesian derivatives.
6521 write (2,*) 'In eello6_graph2'
6523 write (2,*) 'iii=',iii
6525 write (2,*) 'kkk=',kkk
6527 write (2,'(3(2f10.5),5x)')
6528 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6538 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6540 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6543 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6545 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6546 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6548 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6549 call transpose2(EUg(1,1,k),auxmat(1,1))
6550 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6552 vv(1)=pizda(1,1)-pizda(2,2)
6553 vv(2)=pizda(1,2)+pizda(2,1)
6554 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6555 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6557 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6559 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6562 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6564 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6571 c----------------------------------------------------------------------------
6572 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6573 implicit real*8 (a-h,o-z)
6574 include 'DIMENSIONS'
6575 include 'sizesclu.dat'
6576 include 'COMMON.IOUNITS'
6577 include 'COMMON.CHAIN'
6578 include 'COMMON.DERIV'
6579 include 'COMMON.INTERACT'
6580 include 'COMMON.CONTACTS'
6581 include 'COMMON.TORSION'
6582 include 'COMMON.VAR'
6583 include 'COMMON.GEO'
6584 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6586 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6588 C Parallel Antiparallel C
6594 C j|/k\| / |/k\|l / C
6599 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6601 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6602 C energy moment and not to the cluster cumulant.
6603 iti=itortyp(itype(i))
6604 if (j.lt.nres-1) then
6605 itj1=itortyp(itype(j+1))
6609 itk=itortyp(itype(k))
6610 itk1=itortyp(itype(k+1))
6611 if (l.lt.nres-1) then
6612 itl1=itortyp(itype(l+1))
6617 s1=dip(4,jj,i)*dip(4,kk,k)
6619 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6620 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6621 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6622 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6623 call transpose2(EE(1,1,itk),auxmat(1,1))
6624 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6625 vv(1)=pizda(1,1)+pizda(2,2)
6626 vv(2)=pizda(2,1)-pizda(1,2)
6627 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6628 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6630 eello6_graph3=-(s1+s2+s3+s4)
6632 eello6_graph3=-(s2+s3+s4)
6635 if (.not. calc_grad) return
6636 C Derivatives in gamma(k-1)
6637 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6638 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6639 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6640 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6641 C Derivatives in gamma(l-1)
6642 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6643 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6644 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6645 vv(1)=pizda(1,1)+pizda(2,2)
6646 vv(2)=pizda(2,1)-pizda(1,2)
6647 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6648 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6649 C Cartesian derivatives.
6655 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6657 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6660 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6662 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6663 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6665 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6666 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6668 vv(1)=pizda(1,1)+pizda(2,2)
6669 vv(2)=pizda(2,1)-pizda(1,2)
6670 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6672 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6674 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6677 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6679 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6681 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6687 c----------------------------------------------------------------------------
6688 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6689 implicit real*8 (a-h,o-z)
6690 include 'DIMENSIONS'
6691 include 'sizesclu.dat'
6692 include 'COMMON.IOUNITS'
6693 include 'COMMON.CHAIN'
6694 include 'COMMON.DERIV'
6695 include 'COMMON.INTERACT'
6696 include 'COMMON.CONTACTS'
6697 include 'COMMON.TORSION'
6698 include 'COMMON.VAR'
6699 include 'COMMON.GEO'
6700 include 'COMMON.FFIELD'
6701 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6702 & auxvec1(2),auxmat1(2,2)
6704 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6706 C Parallel Antiparallel C
6712 C \ j|/k\| \ |/k\|l C
6717 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6719 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6720 C energy moment and not to the cluster cumulant.
6721 cd write (2,*) 'eello_graph4: wturn6',wturn6
6722 iti=itortyp(itype(i))
6723 itj=itortyp(itype(j))
6724 if (j.lt.nres-1) then
6725 itj1=itortyp(itype(j+1))
6729 itk=itortyp(itype(k))
6730 if (k.lt.nres-1) then
6731 itk1=itortyp(itype(k+1))
6735 itl=itortyp(itype(l))
6736 if (l.lt.nres-1) then
6737 itl1=itortyp(itype(l+1))
6741 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6742 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6743 cd & ' itl',itl,' itl1',itl1
6746 s1=dip(3,jj,i)*dip(3,kk,k)
6748 s1=dip(2,jj,j)*dip(2,kk,l)
6751 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6752 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6754 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6755 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6757 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6758 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6760 call transpose2(EUg(1,1,k),auxmat(1,1))
6761 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6762 vv(1)=pizda(1,1)-pizda(2,2)
6763 vv(2)=pizda(2,1)+pizda(1,2)
6764 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6765 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6767 eello6_graph4=-(s1+s2+s3+s4)
6769 eello6_graph4=-(s2+s3+s4)
6771 if (.not. calc_grad) return
6772 C Derivatives in gamma(i-1)
6776 s1=dipderg(2,jj,i)*dip(3,kk,k)
6778 s1=dipderg(4,jj,j)*dip(2,kk,l)
6781 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6783 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6784 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6786 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6787 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6789 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6790 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6791 cd write (2,*) 'turn6 derivatives'
6793 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6795 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6799 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6801 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6805 C Derivatives in gamma(k-1)
6808 s1=dip(3,jj,i)*dipderg(2,kk,k)
6810 s1=dip(2,jj,j)*dipderg(4,kk,l)
6813 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6814 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6816 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6817 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6819 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6820 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6822 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6823 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6824 vv(1)=pizda(1,1)-pizda(2,2)
6825 vv(2)=pizda(2,1)+pizda(1,2)
6826 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6827 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6829 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6831 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6835 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6837 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6840 C Derivatives in gamma(j-1) or gamma(l-1)
6841 if (l.eq.j+1 .and. l.gt.1) then
6842 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6843 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6844 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6845 vv(1)=pizda(1,1)-pizda(2,2)
6846 vv(2)=pizda(2,1)+pizda(1,2)
6847 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6848 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6849 else if (j.gt.1) then
6850 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6851 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6852 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6853 vv(1)=pizda(1,1)-pizda(2,2)
6854 vv(2)=pizda(2,1)+pizda(1,2)
6855 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6856 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6857 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6859 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6862 C Cartesian derivatives.
6869 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6871 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6875 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6877 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6881 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6883 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6885 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6886 & b1(1,itj1),auxvec(1))
6887 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6889 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6890 & b1(1,itl1),auxvec(1))
6891 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6893 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6895 vv(1)=pizda(1,1)-pizda(2,2)
6896 vv(2)=pizda(2,1)+pizda(1,2)
6897 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6899 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6901 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6904 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6907 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6910 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6912 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6914 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6918 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6920 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6923 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6925 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6933 c----------------------------------------------------------------------------
6934 double precision function eello_turn6(i,jj,kk)
6935 implicit real*8 (a-h,o-z)
6936 include 'DIMENSIONS'
6937 include 'sizesclu.dat'
6938 include 'COMMON.IOUNITS'
6939 include 'COMMON.CHAIN'
6940 include 'COMMON.DERIV'
6941 include 'COMMON.INTERACT'
6942 include 'COMMON.CONTACTS'
6943 include 'COMMON.TORSION'
6944 include 'COMMON.VAR'
6945 include 'COMMON.GEO'
6946 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6947 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6949 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6950 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6951 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6952 C the respective energy moment and not to the cluster cumulant.
6957 iti=itortyp(itype(i))
6958 itk=itortyp(itype(k))
6959 itk1=itortyp(itype(k+1))
6960 itl=itortyp(itype(l))
6961 itj=itortyp(itype(j))
6962 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6963 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6964 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6969 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6971 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6975 derx_turn(lll,kkk,iii)=0.0d0
6982 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6984 cd write (2,*) 'eello6_5',eello6_5
6986 call transpose2(AEA(1,1,1),auxmat(1,1))
6987 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
6988 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
6989 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
6993 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
6994 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
6995 s2 = scalar2(b1(1,itk),vtemp1(1))
6997 call transpose2(AEA(1,1,2),atemp(1,1))
6998 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
6999 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7000 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7004 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7005 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7006 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7008 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7009 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7010 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7011 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7012 ss13 = scalar2(b1(1,itk),vtemp4(1))
7013 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7017 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7023 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7025 C Derivatives in gamma(i+2)
7027 call transpose2(AEA(1,1,1),auxmatd(1,1))
7028 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7029 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7030 call transpose2(AEAderg(1,1,2),atempd(1,1))
7031 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7032 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7036 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7037 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7038 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7044 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7045 C Derivatives in gamma(i+3)
7047 call transpose2(AEA(1,1,1),auxmatd(1,1))
7048 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7049 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7050 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7054 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7055 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7056 s2d = scalar2(b1(1,itk),vtemp1d(1))
7058 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7059 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7061 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7063 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7064 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7065 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7075 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7076 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7078 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7079 & -0.5d0*ekont*(s2d+s12d)
7081 C Derivatives in gamma(i+4)
7082 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7083 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7084 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7086 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7087 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7088 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7098 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7100 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7102 C Derivatives in gamma(i+5)
7104 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7105 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7106 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7110 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7111 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7112 s2d = scalar2(b1(1,itk),vtemp1d(1))
7114 call transpose2(AEA(1,1,2),atempd(1,1))
7115 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7116 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7120 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7121 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7123 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7124 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7125 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7135 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7136 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7138 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7139 & -0.5d0*ekont*(s2d+s12d)
7141 C Cartesian derivatives
7146 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7147 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7148 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7152 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7153 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7155 s2d = scalar2(b1(1,itk),vtemp1d(1))
7157 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7158 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7159 s8d = -(atempd(1,1)+atempd(2,2))*
7160 & scalar2(cc(1,1,itl),vtemp2(1))
7164 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7166 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7167 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7174 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7177 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7181 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7182 & - 0.5d0*(s8d+s12d)
7184 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7193 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7195 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7196 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7197 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7198 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7199 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7201 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7202 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7203 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7207 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7208 cd & 16*eel_turn6_num
7210 if (j.lt.nres-1) then
7217 if (l.lt.nres-1) then
7225 ggg1(ll)=eel_turn6*g_contij(ll,1)
7226 ggg2(ll)=eel_turn6*g_contij(ll,2)
7227 ghalf=0.5d0*ggg1(ll)
7229 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7230 & +ekont*derx_turn(ll,2,1)
7231 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7232 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7233 & +ekont*derx_turn(ll,4,1)
7234 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7235 ghalf=0.5d0*ggg2(ll)
7237 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7238 & +ekont*derx_turn(ll,2,2)
7239 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7240 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7241 & +ekont*derx_turn(ll,4,2)
7242 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7247 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7252 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7258 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7263 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7267 cd write (2,*) iii,g_corr6_loc(iii)
7270 eello_turn6=ekont*eel_turn6
7271 cd write (2,*) 'ekont',ekont
7272 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7275 crc-------------------------------------------------
7276 SUBROUTINE MATVEC2(A1,V1,V2)
7277 implicit real*8 (a-h,o-z)
7278 include 'DIMENSIONS'
7279 DIMENSION A1(2,2),V1(2),V2(2)
7283 c 3 VI=VI+A1(I,K)*V1(K)
7287 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7288 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7293 C---------------------------------------
7294 SUBROUTINE MATMAT2(A1,A2,A3)
7295 implicit real*8 (a-h,o-z)
7296 include 'DIMENSIONS'
7297 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7298 c DIMENSION AI3(2,2)
7302 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7308 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7309 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7310 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7311 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7319 c-------------------------------------------------------------------------
7320 double precision function scalar2(u,v)
7322 double precision u(2),v(2)
7325 scalar2=u(1)*v(1)+u(2)*v(2)
7329 C-----------------------------------------------------------------------------
7331 subroutine transpose2(a,at)
7333 double precision a(2,2),at(2,2)
7340 c--------------------------------------------------------------------------
7341 subroutine transpose(n,a,at)
7344 double precision a(n,n),at(n,n)
7352 C---------------------------------------------------------------------------
7353 subroutine prodmat3(a1,a2,kk,transp,prod)
7356 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7358 crc double precision auxmat(2,2),prod_(2,2)
7361 crc call transpose2(kk(1,1),auxmat(1,1))
7362 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7363 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7365 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7366 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7367 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7368 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7369 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7370 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7371 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7372 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7375 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7376 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7378 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7379 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7380 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7381 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7382 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7383 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7384 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7385 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7388 c call transpose2(a2(1,1),a2t(1,1))
7391 crc print *,((prod_(i,j),i=1,2),j=1,2)
7392 crc print *,((prod(i,j),i=1,2),j=1,2)
7396 C-----------------------------------------------------------------------------
7397 double precision function scalar(u,v)
7399 double precision u(3),v(3)