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
4515 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
4517 >>>>>>> 3d6f9e7... Adam's changes to wham and cluster following previous commit
4518 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4520 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4521 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4522 c &gloc_sc(intertyp,i-3,icg)
4524 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4525 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4526 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4527 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4528 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4534 c------------------------------------------------------------------------------
4535 subroutine multibody(ecorr)
4536 C This subroutine calculates multi-body contributions to energy following
4537 C the idea of Skolnick et al. If side chains I and J make a contact and
4538 C at the same time side chains I+1 and J+1 make a contact, an extra
4539 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4540 implicit real*8 (a-h,o-z)
4541 include 'DIMENSIONS'
4542 include 'COMMON.IOUNITS'
4543 include 'COMMON.DERIV'
4544 include 'COMMON.INTERACT'
4545 include 'COMMON.CONTACTS'
4546 double precision gx(3),gx1(3)
4549 C Set lprn=.true. for debugging
4553 write (iout,'(a)') 'Contact function values:'
4555 write (iout,'(i2,20(1x,i2,f10.5))')
4556 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4571 num_conti=num_cont(i)
4572 num_conti1=num_cont(i1)
4577 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4578 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4579 cd & ' ishift=',ishift
4580 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4581 C The system gains extra energy.
4582 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4583 endif ! j1==j+-ishift
4592 c------------------------------------------------------------------------------
4593 double precision function esccorr(i,j,k,l,jj,kk)
4594 implicit real*8 (a-h,o-z)
4595 include 'DIMENSIONS'
4596 include 'COMMON.IOUNITS'
4597 include 'COMMON.DERIV'
4598 include 'COMMON.INTERACT'
4599 include 'COMMON.CONTACTS'
4600 double precision gx(3),gx1(3)
4605 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4606 C Calculate the multi-body contribution to energy.
4607 C Calculate multi-body contributions to the gradient.
4608 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4609 cd & k,l,(gacont(m,kk,k),m=1,3)
4611 gx(m) =ekl*gacont(m,jj,i)
4612 gx1(m)=eij*gacont(m,kk,k)
4613 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4614 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4615 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4616 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4620 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4625 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4631 c------------------------------------------------------------------------------
4633 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4634 implicit real*8 (a-h,o-z)
4635 include 'DIMENSIONS'
4636 integer dimen1,dimen2,atom,indx
4637 double precision buffer(dimen1,dimen2)
4638 double precision zapas
4639 common /contacts_hb/ zapas(3,20,maxres,7),
4640 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4641 & num_cont_hb(maxres),jcont_hb(20,maxres)
4642 num_kont=num_cont_hb(atom)
4646 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4649 buffer(i,indx+22)=facont_hb(i,atom)
4650 buffer(i,indx+23)=ees0p(i,atom)
4651 buffer(i,indx+24)=ees0m(i,atom)
4652 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4654 buffer(1,indx+26)=dfloat(num_kont)
4657 c------------------------------------------------------------------------------
4658 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4659 implicit real*8 (a-h,o-z)
4660 include 'DIMENSIONS'
4661 integer dimen1,dimen2,atom,indx
4662 double precision buffer(dimen1,dimen2)
4663 double precision zapas
4664 common /contacts_hb/ zapas(3,20,maxres,7),
4665 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4666 & num_cont_hb(maxres),jcont_hb(20,maxres)
4667 num_kont=buffer(1,indx+26)
4668 num_kont_old=num_cont_hb(atom)
4669 num_cont_hb(atom)=num_kont+num_kont_old
4674 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4677 facont_hb(ii,atom)=buffer(i,indx+22)
4678 ees0p(ii,atom)=buffer(i,indx+23)
4679 ees0m(ii,atom)=buffer(i,indx+24)
4680 jcont_hb(ii,atom)=buffer(i,indx+25)
4684 c------------------------------------------------------------------------------
4686 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4687 C This subroutine calculates multi-body contributions to hydrogen-bonding
4688 implicit real*8 (a-h,o-z)
4689 include 'DIMENSIONS'
4690 include 'sizesclu.dat'
4691 include 'COMMON.IOUNITS'
4693 include 'COMMON.INFO'
4695 include 'COMMON.FFIELD'
4696 include 'COMMON.DERIV'
4697 include 'COMMON.INTERACT'
4698 include 'COMMON.CONTACTS'
4700 parameter (max_cont=maxconts)
4701 parameter (max_dim=2*(8*3+2))
4702 parameter (msglen1=max_cont*max_dim*4)
4703 parameter (msglen2=2*msglen1)
4704 integer source,CorrelType,CorrelID,Error
4705 double precision buffer(max_cont,max_dim)
4707 double precision gx(3),gx1(3)
4710 C Set lprn=.true. for debugging
4715 if (fgProcs.le.1) goto 30
4717 write (iout,'(a)') 'Contact function values:'
4719 write (iout,'(2i3,50(1x,i2,f5.2))')
4720 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4721 & j=1,num_cont_hb(i))
4724 C Caution! Following code assumes that electrostatic interactions concerning
4725 C a given atom are split among at most two processors!
4735 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4738 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4739 if (MyRank.gt.0) then
4740 C Send correlation contributions to the preceding processor
4742 nn=num_cont_hb(iatel_s)
4743 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4744 cd write (iout,*) 'The BUFFER array:'
4746 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4748 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4750 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4751 C Clear the contacts of the atom passed to the neighboring processor
4752 nn=num_cont_hb(iatel_s+1)
4754 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4756 num_cont_hb(iatel_s)=0
4758 cd write (iout,*) 'Processor ',MyID,MyRank,
4759 cd & ' is sending correlation contribution to processor',MyID-1,
4760 cd & ' msglen=',msglen
4761 cd write (*,*) 'Processor ',MyID,MyRank,
4762 cd & ' is sending correlation contribution to processor',MyID-1,
4763 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4764 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4765 cd write (iout,*) 'Processor ',MyID,
4766 cd & ' has sent correlation contribution to processor',MyID-1,
4767 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4768 cd write (*,*) 'Processor ',MyID,
4769 cd & ' has sent correlation contribution to processor',MyID-1,
4770 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4772 endif ! (MyRank.gt.0)
4776 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4777 if (MyRank.lt.fgProcs-1) then
4778 C Receive correlation contributions from the next processor
4780 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4781 cd write (iout,*) 'Processor',MyID,
4782 cd & ' is receiving correlation contribution from processor',MyID+1,
4783 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4784 cd write (*,*) 'Processor',MyID,
4785 cd & ' is receiving correlation contribution from processor',MyID+1,
4786 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4788 do while (nbytes.le.0)
4789 call mp_probe(MyID+1,CorrelType,nbytes)
4791 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4792 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4793 cd write (iout,*) 'Processor',MyID,
4794 cd & ' has received correlation contribution from processor',MyID+1,
4795 cd & ' msglen=',msglen,' nbytes=',nbytes
4796 cd write (iout,*) 'The received BUFFER array:'
4798 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4800 if (msglen.eq.msglen1) then
4801 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4802 else if (msglen.eq.msglen2) then
4803 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4804 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4807 & 'ERROR!!!! message length changed while processing correlations.'
4809 & 'ERROR!!!! message length changed while processing correlations.'
4810 call mp_stopall(Error)
4811 endif ! msglen.eq.msglen1
4812 endif ! MyRank.lt.fgProcs-1
4819 write (iout,'(a)') 'Contact function values:'
4821 write (iout,'(2i3,50(1x,i2,f5.2))')
4822 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4823 & j=1,num_cont_hb(i))
4827 C Remove the loop below after debugging !!!
4834 C Calculate the local-electrostatic correlation terms
4835 do i=iatel_s,iatel_e+1
4837 num_conti=num_cont_hb(i)
4838 num_conti1=num_cont_hb(i+1)
4843 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4844 c & ' jj=',jj,' kk=',kk
4845 if (j1.eq.j+1 .or. j1.eq.j-1) then
4846 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4847 C The system gains extra energy.
4848 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4850 else if (j1.eq.j) then
4851 C Contacts I-J and I-(J+1) occur simultaneously.
4852 C The system loses extra energy.
4853 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4858 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4859 c & ' jj=',jj,' kk=',kk
4861 C Contacts I-J and (I+1)-J occur simultaneously.
4862 C The system loses extra energy.
4863 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4870 c------------------------------------------------------------------------------
4871 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4873 C This subroutine calculates multi-body contributions to hydrogen-bonding
4874 implicit real*8 (a-h,o-z)
4875 include 'DIMENSIONS'
4876 include 'sizesclu.dat'
4877 include 'COMMON.IOUNITS'
4879 include 'COMMON.INFO'
4881 include 'COMMON.FFIELD'
4882 include 'COMMON.DERIV'
4883 include 'COMMON.INTERACT'
4884 include 'COMMON.CONTACTS'
4886 parameter (max_cont=maxconts)
4887 parameter (max_dim=2*(8*3+2))
4888 parameter (msglen1=max_cont*max_dim*4)
4889 parameter (msglen2=2*msglen1)
4890 integer source,CorrelType,CorrelID,Error
4891 double precision buffer(max_cont,max_dim)
4893 double precision gx(3),gx1(3)
4896 C Set lprn=.true. for debugging
4903 if (fgProcs.le.1) goto 30
4905 write (iout,'(a)') 'Contact function values:'
4907 write (iout,'(2i3,50(1x,i2,f5.2))')
4908 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4909 & j=1,num_cont_hb(i))
4912 C Caution! Following code assumes that electrostatic interactions concerning
4913 C a given atom are split among at most two processors!
4923 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4926 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4927 if (MyRank.gt.0) then
4928 C Send correlation contributions to the preceding processor
4930 nn=num_cont_hb(iatel_s)
4931 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4932 cd write (iout,*) 'The BUFFER array:'
4934 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4936 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4938 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4939 C Clear the contacts of the atom passed to the neighboring processor
4940 nn=num_cont_hb(iatel_s+1)
4942 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4944 num_cont_hb(iatel_s)=0
4946 cd write (iout,*) 'Processor ',MyID,MyRank,
4947 cd & ' is sending correlation contribution to processor',MyID-1,
4948 cd & ' msglen=',msglen
4949 cd write (*,*) 'Processor ',MyID,MyRank,
4950 cd & ' is sending correlation contribution to processor',MyID-1,
4951 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4952 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4953 cd write (iout,*) 'Processor ',MyID,
4954 cd & ' has sent correlation contribution to processor',MyID-1,
4955 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4956 cd write (*,*) 'Processor ',MyID,
4957 cd & ' has sent correlation contribution to processor',MyID-1,
4958 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4960 endif ! (MyRank.gt.0)
4964 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4965 if (MyRank.lt.fgProcs-1) then
4966 C Receive correlation contributions from the next processor
4968 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4969 cd write (iout,*) 'Processor',MyID,
4970 cd & ' is receiving correlation contribution from processor',MyID+1,
4971 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4972 cd write (*,*) 'Processor',MyID,
4973 cd & ' is receiving correlation contribution from processor',MyID+1,
4974 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4976 do while (nbytes.le.0)
4977 call mp_probe(MyID+1,CorrelType,nbytes)
4979 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4980 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4981 cd write (iout,*) 'Processor',MyID,
4982 cd & ' has received correlation contribution from processor',MyID+1,
4983 cd & ' msglen=',msglen,' nbytes=',nbytes
4984 cd write (iout,*) 'The received BUFFER array:'
4986 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4988 if (msglen.eq.msglen1) then
4989 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4990 else if (msglen.eq.msglen2) then
4991 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4992 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4995 & 'ERROR!!!! message length changed while processing correlations.'
4997 & 'ERROR!!!! message length changed while processing correlations.'
4998 call mp_stopall(Error)
4999 endif ! msglen.eq.msglen1
5000 endif ! MyRank.lt.fgProcs-1
5007 write (iout,'(a)') 'Contact function values:'
5009 write (iout,'(2i3,50(1x,i2,f5.2))')
5010 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5011 & j=1,num_cont_hb(i))
5017 C Remove the loop below after debugging !!!
5024 C Calculate the dipole-dipole interaction energies
5025 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5026 do i=iatel_s,iatel_e+1
5027 num_conti=num_cont_hb(i)
5034 C Calculate the local-electrostatic correlation terms
5035 do i=iatel_s,iatel_e+1
5037 num_conti=num_cont_hb(i)
5038 num_conti1=num_cont_hb(i+1)
5043 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5044 c & ' jj=',jj,' kk=',kk
5045 if (j1.eq.j+1 .or. j1.eq.j-1) then
5046 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5047 C The system gains extra energy.
5049 sqd1=dsqrt(d_cont(jj,i))
5050 sqd2=dsqrt(d_cont(kk,i1))
5051 sred_geom = sqd1*sqd2
5052 IF (sred_geom.lt.cutoff_corr) THEN
5053 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5055 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5056 c & ' jj=',jj,' kk=',kk
5057 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5058 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5060 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5061 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5064 cd write (iout,*) 'sred_geom=',sred_geom,
5065 cd & ' ekont=',ekont,' fprim=',fprimcont
5066 call calc_eello(i,j,i+1,j1,jj,kk)
5067 if (wcorr4.gt.0.0d0)
5068 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5069 if (wcorr5.gt.0.0d0)
5070 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5071 c print *,"wcorr5",ecorr5
5072 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5073 cd write(2,*)'ijkl',i,j,i+1,j1
5074 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5075 & .or. wturn6.eq.0.0d0))then
5076 c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5077 c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5078 c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5079 c & 'ecorr6=',ecorr6, wcorr6
5080 cd write (iout,'(4e15.5)') sred_geom,
5081 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5082 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5083 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5084 else if (wturn6.gt.0.0d0
5085 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5086 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5087 eturn6=eturn6+eello_turn6(i,jj,kk)
5088 cd write (2,*) 'multibody_eello:eturn6',eturn6
5092 else if (j1.eq.j) then
5093 C Contacts I-J and I-(J+1) occur simultaneously.
5094 C The system loses extra energy.
5095 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5100 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5101 c & ' jj=',jj,' kk=',kk
5103 C Contacts I-J and (I+1)-J occur simultaneously.
5104 C The system loses extra energy.
5105 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5112 c------------------------------------------------------------------------------
5113 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5114 implicit real*8 (a-h,o-z)
5115 include 'DIMENSIONS'
5116 include 'COMMON.IOUNITS'
5117 include 'COMMON.DERIV'
5118 include 'COMMON.INTERACT'
5119 include 'COMMON.CONTACTS'
5120 double precision gx(3),gx1(3)
5130 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5131 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5132 C Following 4 lines for diagnostics.
5137 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5139 c write (iout,*)'Contacts have occurred for peptide groups',
5140 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5141 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5142 C Calculate the multi-body contribution to energy.
5143 ecorr=ecorr+ekont*ees
5145 C Calculate multi-body contributions to the gradient.
5147 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5148 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5149 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5150 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5151 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5152 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5153 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5154 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5155 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5156 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5157 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5158 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5159 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5160 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5164 gradcorr(ll,m)=gradcorr(ll,m)+
5165 & ees*ekl*gacont_hbr(ll,jj,i)-
5166 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5167 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5172 gradcorr(ll,m)=gradcorr(ll,m)+
5173 & ees*eij*gacont_hbr(ll,kk,k)-
5174 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5175 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5182 C---------------------------------------------------------------------------
5183 subroutine dipole(i,j,jj)
5184 implicit real*8 (a-h,o-z)
5185 include 'DIMENSIONS'
5186 include 'sizesclu.dat'
5187 include 'COMMON.IOUNITS'
5188 include 'COMMON.CHAIN'
5189 include 'COMMON.FFIELD'
5190 include 'COMMON.DERIV'
5191 include 'COMMON.INTERACT'
5192 include 'COMMON.CONTACTS'
5193 include 'COMMON.TORSION'
5194 include 'COMMON.VAR'
5195 include 'COMMON.GEO'
5196 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5198 iti1 = itortyp(itype(i+1))
5199 if (j.lt.nres-1) then
5200 itj1 = itortyp(itype(j+1))
5205 dipi(iii,1)=Ub2(iii,i)
5206 dipderi(iii)=Ub2der(iii,i)
5207 dipi(iii,2)=b1(iii,iti1)
5208 dipj(iii,1)=Ub2(iii,j)
5209 dipderj(iii)=Ub2der(iii,j)
5210 dipj(iii,2)=b1(iii,itj1)
5214 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5217 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5220 if (.not.calc_grad) return
5225 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5229 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5234 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5235 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5237 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5239 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5241 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5245 C---------------------------------------------------------------------------
5246 subroutine calc_eello(i,j,k,l,jj,kk)
5248 C This subroutine computes matrices and vectors needed to calculate
5249 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5251 implicit real*8 (a-h,o-z)
5252 include 'DIMENSIONS'
5253 include 'sizesclu.dat'
5254 include 'COMMON.IOUNITS'
5255 include 'COMMON.CHAIN'
5256 include 'COMMON.DERIV'
5257 include 'COMMON.INTERACT'
5258 include 'COMMON.CONTACTS'
5259 include 'COMMON.TORSION'
5260 include 'COMMON.VAR'
5261 include 'COMMON.GEO'
5262 include 'COMMON.FFIELD'
5263 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5264 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5267 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5268 cd & ' jj=',jj,' kk=',kk
5269 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5272 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5273 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5276 call transpose2(aa1(1,1),aa1t(1,1))
5277 call transpose2(aa2(1,1),aa2t(1,1))
5280 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5281 & aa1tder(1,1,lll,kkk))
5282 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5283 & aa2tder(1,1,lll,kkk))
5287 C parallel orientation of the two CA-CA-CA frames.
5289 iti=itortyp(itype(i))
5293 itk1=itortyp(itype(k+1))
5294 itj=itortyp(itype(j))
5295 if (l.lt.nres-1) then
5296 itl1=itortyp(itype(l+1))
5300 C A1 kernel(j+1) A2T
5302 cd write (iout,'(3f10.5,5x,3f10.5)')
5303 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5305 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5306 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5307 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5308 C Following matrices are needed only for 6-th order cumulants
5309 IF (wcorr6.gt.0.0d0) THEN
5310 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5311 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5312 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5313 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5314 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5315 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5316 & ADtEAderx(1,1,1,1,1,1))
5318 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5319 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5320 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5321 & ADtEA1derx(1,1,1,1,1,1))
5323 C End 6-th order cumulants
5326 cd write (2,*) 'In calc_eello6'
5328 cd write (2,*) 'iii=',iii
5330 cd write (2,*) 'kkk=',kkk
5332 cd write (2,'(3(2f10.5),5x)')
5333 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5338 call transpose2(EUgder(1,1,k),auxmat(1,1))
5339 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5340 call transpose2(EUg(1,1,k),auxmat(1,1))
5341 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5342 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5346 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5347 & EAEAderx(1,1,lll,kkk,iii,1))
5351 C A1T kernel(i+1) A2
5352 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5353 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5354 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5355 C Following matrices are needed only for 6-th order cumulants
5356 IF (wcorr6.gt.0.0d0) THEN
5357 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5358 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5359 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5360 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5361 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5362 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5363 & ADtEAderx(1,1,1,1,1,2))
5364 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5365 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5366 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5367 & ADtEA1derx(1,1,1,1,1,2))
5369 C End 6-th order cumulants
5370 call transpose2(EUgder(1,1,l),auxmat(1,1))
5371 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5372 call transpose2(EUg(1,1,l),auxmat(1,1))
5373 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5374 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5378 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5379 & EAEAderx(1,1,lll,kkk,iii,2))
5384 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5385 C They are needed only when the fifth- or the sixth-order cumulants are
5387 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5388 call transpose2(AEA(1,1,1),auxmat(1,1))
5389 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5390 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5391 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5392 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5393 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5394 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5395 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5396 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5397 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5398 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5399 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5400 call transpose2(AEA(1,1,2),auxmat(1,1))
5401 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5402 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5403 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5404 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5405 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5406 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5407 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5408 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5409 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5410 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5411 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5412 C Calculate the Cartesian derivatives of the vectors.
5416 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5417 call matvec2(auxmat(1,1),b1(1,iti),
5418 & AEAb1derx(1,lll,kkk,iii,1,1))
5419 call matvec2(auxmat(1,1),Ub2(1,i),
5420 & AEAb2derx(1,lll,kkk,iii,1,1))
5421 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5422 & AEAb1derx(1,lll,kkk,iii,2,1))
5423 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5424 & AEAb2derx(1,lll,kkk,iii,2,1))
5425 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5426 call matvec2(auxmat(1,1),b1(1,itj),
5427 & AEAb1derx(1,lll,kkk,iii,1,2))
5428 call matvec2(auxmat(1,1),Ub2(1,j),
5429 & AEAb2derx(1,lll,kkk,iii,1,2))
5430 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5431 & AEAb1derx(1,lll,kkk,iii,2,2))
5432 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5433 & AEAb2derx(1,lll,kkk,iii,2,2))
5440 C Antiparallel orientation of the two CA-CA-CA frames.
5442 iti=itortyp(itype(i))
5446 itk1=itortyp(itype(k+1))
5447 itl=itortyp(itype(l))
5448 itj=itortyp(itype(j))
5449 if (j.lt.nres-1) then
5450 itj1=itortyp(itype(j+1))
5454 C A2 kernel(j-1)T A1T
5455 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5456 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5457 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5458 C Following matrices are needed only for 6-th order cumulants
5459 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5460 & j.eq.i+4 .and. l.eq.i+3)) THEN
5461 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5462 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5463 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5464 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5465 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5466 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5467 & ADtEAderx(1,1,1,1,1,1))
5468 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5469 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5470 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5471 & ADtEA1derx(1,1,1,1,1,1))
5473 C End 6-th order cumulants
5474 call transpose2(EUgder(1,1,k),auxmat(1,1))
5475 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5476 call transpose2(EUg(1,1,k),auxmat(1,1))
5477 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5478 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5482 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5483 & EAEAderx(1,1,lll,kkk,iii,1))
5487 C A2T kernel(i+1)T A1
5488 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5489 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5490 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5491 C Following matrices are needed only for 6-th order cumulants
5492 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5493 & j.eq.i+4 .and. l.eq.i+3)) THEN
5494 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5495 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5496 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5497 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5498 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5499 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5500 & ADtEAderx(1,1,1,1,1,2))
5501 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5502 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5503 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5504 & ADtEA1derx(1,1,1,1,1,2))
5506 C End 6-th order cumulants
5507 call transpose2(EUgder(1,1,j),auxmat(1,1))
5508 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5509 call transpose2(EUg(1,1,j),auxmat(1,1))
5510 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5511 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5515 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5516 & EAEAderx(1,1,lll,kkk,iii,2))
5521 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5522 C They are needed only when the fifth- or the sixth-order cumulants are
5524 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5525 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5526 call transpose2(AEA(1,1,1),auxmat(1,1))
5527 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5528 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5529 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5530 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5531 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5532 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5533 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5534 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5535 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5536 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5537 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5538 call transpose2(AEA(1,1,2),auxmat(1,1))
5539 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5540 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5541 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5542 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5543 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5544 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5545 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5546 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5547 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5548 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5549 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5550 C Calculate the Cartesian derivatives of the vectors.
5554 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5555 call matvec2(auxmat(1,1),b1(1,iti),
5556 & AEAb1derx(1,lll,kkk,iii,1,1))
5557 call matvec2(auxmat(1,1),Ub2(1,i),
5558 & AEAb2derx(1,lll,kkk,iii,1,1))
5559 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5560 & AEAb1derx(1,lll,kkk,iii,2,1))
5561 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5562 & AEAb2derx(1,lll,kkk,iii,2,1))
5563 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5564 call matvec2(auxmat(1,1),b1(1,itl),
5565 & AEAb1derx(1,lll,kkk,iii,1,2))
5566 call matvec2(auxmat(1,1),Ub2(1,l),
5567 & AEAb2derx(1,lll,kkk,iii,1,2))
5568 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5569 & AEAb1derx(1,lll,kkk,iii,2,2))
5570 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5571 & AEAb2derx(1,lll,kkk,iii,2,2))
5580 C---------------------------------------------------------------------------
5581 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5582 & KK,KKderg,AKA,AKAderg,AKAderx)
5586 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5587 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5588 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5593 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5595 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5598 cd if (lprn) write (2,*) 'In kernel'
5600 cd if (lprn) write (2,*) 'kkk=',kkk
5602 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5603 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5605 cd write (2,*) 'lll=',lll
5606 cd write (2,*) 'iii=1'
5608 cd write (2,'(3(2f10.5),5x)')
5609 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5612 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5613 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5615 cd write (2,*) 'lll=',lll
5616 cd write (2,*) 'iii=2'
5618 cd write (2,'(3(2f10.5),5x)')
5619 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5626 C---------------------------------------------------------------------------
5627 double precision function eello4(i,j,k,l,jj,kk)
5628 implicit real*8 (a-h,o-z)
5629 include 'DIMENSIONS'
5630 include 'sizesclu.dat'
5631 include 'COMMON.IOUNITS'
5632 include 'COMMON.CHAIN'
5633 include 'COMMON.DERIV'
5634 include 'COMMON.INTERACT'
5635 include 'COMMON.CONTACTS'
5636 include 'COMMON.TORSION'
5637 include 'COMMON.VAR'
5638 include 'COMMON.GEO'
5639 double precision pizda(2,2),ggg1(3),ggg2(3)
5640 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5644 cd print *,'eello4:',i,j,k,l,jj,kk
5645 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5646 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5647 cold eij=facont_hb(jj,i)
5648 cold ekl=facont_hb(kk,k)
5650 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5652 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5653 gcorr_loc(k-1)=gcorr_loc(k-1)
5654 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5656 gcorr_loc(l-1)=gcorr_loc(l-1)
5657 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5659 gcorr_loc(j-1)=gcorr_loc(j-1)
5660 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5665 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5666 & -EAEAderx(2,2,lll,kkk,iii,1)
5667 cd derx(lll,kkk,iii)=0.0d0
5671 cd gcorr_loc(l-1)=0.0d0
5672 cd gcorr_loc(j-1)=0.0d0
5673 cd gcorr_loc(k-1)=0.0d0
5675 cd write (iout,*)'Contacts have occurred for peptide groups',
5676 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5677 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5678 if (j.lt.nres-1) then
5685 if (l.lt.nres-1) then
5693 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5694 ggg1(ll)=eel4*g_contij(ll,1)
5695 ggg2(ll)=eel4*g_contij(ll,2)
5696 ghalf=0.5d0*ggg1(ll)
5698 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5699 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5700 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5701 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5702 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5703 ghalf=0.5d0*ggg2(ll)
5705 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5706 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5707 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5708 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5713 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5714 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5719 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5720 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5726 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5731 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5735 cd write (2,*) iii,gcorr_loc(iii)
5739 cd write (2,*) 'ekont',ekont
5740 cd write (iout,*) 'eello4',ekont*eel4
5743 C---------------------------------------------------------------------------
5744 double precision function eello5(i,j,k,l,jj,kk)
5745 implicit real*8 (a-h,o-z)
5746 include 'DIMENSIONS'
5747 include 'sizesclu.dat'
5748 include 'COMMON.IOUNITS'
5749 include 'COMMON.CHAIN'
5750 include 'COMMON.DERIV'
5751 include 'COMMON.INTERACT'
5752 include 'COMMON.CONTACTS'
5753 include 'COMMON.TORSION'
5754 include 'COMMON.VAR'
5755 include 'COMMON.GEO'
5756 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5757 double precision ggg1(3),ggg2(3)
5758 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5763 C /l\ / \ \ / \ / \ / C
5764 C / \ / \ \ / \ / \ / C
5765 C j| o |l1 | o | o| o | | o |o C
5766 C \ |/k\| |/ \| / |/ \| |/ \| C
5767 C \i/ \ / \ / / \ / \ C
5769 C (I) (II) (III) (IV) C
5771 C eello5_1 eello5_2 eello5_3 eello5_4 C
5773 C Antiparallel chains C
5776 C /j\ / \ \ / \ / \ / C
5777 C / \ / \ \ / \ / \ / C
5778 C j1| o |l | o | o| o | | o |o C
5779 C \ |/k\| |/ \| / |/ \| |/ \| C
5780 C \i/ \ / \ / / \ / \ C
5782 C (I) (II) (III) (IV) C
5784 C eello5_1 eello5_2 eello5_3 eello5_4 C
5786 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5788 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5789 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5794 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5796 itk=itortyp(itype(k))
5797 itl=itortyp(itype(l))
5798 itj=itortyp(itype(j))
5803 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5804 cd & eel5_3_num,eel5_4_num)
5808 derx(lll,kkk,iii)=0.0d0
5812 cd eij=facont_hb(jj,i)
5813 cd ekl=facont_hb(kk,k)
5815 cd write (iout,*)'Contacts have occurred for peptide groups',
5816 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5818 C Contribution from the graph I.
5819 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5820 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5821 call transpose2(EUg(1,1,k),auxmat(1,1))
5822 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5823 vv(1)=pizda(1,1)-pizda(2,2)
5824 vv(2)=pizda(1,2)+pizda(2,1)
5825 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5826 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5828 C Explicit gradient in virtual-dihedral angles.
5829 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5830 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5831 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5832 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5833 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5834 vv(1)=pizda(1,1)-pizda(2,2)
5835 vv(2)=pizda(1,2)+pizda(2,1)
5836 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5837 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5838 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5839 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5840 vv(1)=pizda(1,1)-pizda(2,2)
5841 vv(2)=pizda(1,2)+pizda(2,1)
5843 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5844 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5845 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5847 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5848 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5849 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5851 C Cartesian gradient
5855 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5857 vv(1)=pizda(1,1)-pizda(2,2)
5858 vv(2)=pizda(1,2)+pizda(2,1)
5859 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5860 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5861 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5868 C Contribution from graph II
5869 call transpose2(EE(1,1,itk),auxmat(1,1))
5870 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5871 vv(1)=pizda(1,1)+pizda(2,2)
5872 vv(2)=pizda(2,1)-pizda(1,2)
5873 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5874 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5876 C Explicit gradient in virtual-dihedral angles.
5877 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5878 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5879 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5880 vv(1)=pizda(1,1)+pizda(2,2)
5881 vv(2)=pizda(2,1)-pizda(1,2)
5883 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5884 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5885 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5887 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5888 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5889 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5891 C Cartesian gradient
5895 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5897 vv(1)=pizda(1,1)+pizda(2,2)
5898 vv(2)=pizda(2,1)-pizda(1,2)
5899 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5900 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5901 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5910 C Parallel orientation
5911 C Contribution from graph III
5912 call transpose2(EUg(1,1,l),auxmat(1,1))
5913 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5914 vv(1)=pizda(1,1)-pizda(2,2)
5915 vv(2)=pizda(1,2)+pizda(2,1)
5916 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5917 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5919 C Explicit gradient in virtual-dihedral angles.
5920 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5921 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5922 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5923 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5924 vv(1)=pizda(1,1)-pizda(2,2)
5925 vv(2)=pizda(1,2)+pizda(2,1)
5926 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5927 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5928 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5929 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5930 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5931 vv(1)=pizda(1,1)-pizda(2,2)
5932 vv(2)=pizda(1,2)+pizda(2,1)
5933 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5934 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5935 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5936 C Cartesian gradient
5940 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5942 vv(1)=pizda(1,1)-pizda(2,2)
5943 vv(2)=pizda(1,2)+pizda(2,1)
5944 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5945 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5946 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5952 C Contribution from graph IV
5954 call transpose2(EE(1,1,itl),auxmat(1,1))
5955 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5956 vv(1)=pizda(1,1)+pizda(2,2)
5957 vv(2)=pizda(2,1)-pizda(1,2)
5958 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5959 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5961 C Explicit gradient in virtual-dihedral angles.
5962 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5963 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5964 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5965 vv(1)=pizda(1,1)+pizda(2,2)
5966 vv(2)=pizda(2,1)-pizda(1,2)
5967 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5968 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5969 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5970 C Cartesian gradient
5974 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5976 vv(1)=pizda(1,1)+pizda(2,2)
5977 vv(2)=pizda(2,1)-pizda(1,2)
5978 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5979 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5980 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5986 C Antiparallel orientation
5987 C Contribution from graph III
5989 call transpose2(EUg(1,1,j),auxmat(1,1))
5990 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5991 vv(1)=pizda(1,1)-pizda(2,2)
5992 vv(2)=pizda(1,2)+pizda(2,1)
5993 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
5994 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5996 C Explicit gradient in virtual-dihedral angles.
5997 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5998 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
5999 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6000 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6001 vv(1)=pizda(1,1)-pizda(2,2)
6002 vv(2)=pizda(1,2)+pizda(2,1)
6003 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6004 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6005 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6006 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6007 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6008 vv(1)=pizda(1,1)-pizda(2,2)
6009 vv(2)=pizda(1,2)+pizda(2,1)
6010 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6011 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6012 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6013 C Cartesian gradient
6017 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6019 vv(1)=pizda(1,1)-pizda(2,2)
6020 vv(2)=pizda(1,2)+pizda(2,1)
6021 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6022 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6023 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6029 C Contribution from graph IV
6031 call transpose2(EE(1,1,itj),auxmat(1,1))
6032 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6033 vv(1)=pizda(1,1)+pizda(2,2)
6034 vv(2)=pizda(2,1)-pizda(1,2)
6035 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6036 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6038 C Explicit gradient in virtual-dihedral angles.
6039 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6040 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6041 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6042 vv(1)=pizda(1,1)+pizda(2,2)
6043 vv(2)=pizda(2,1)-pizda(1,2)
6044 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6045 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6046 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6047 C Cartesian gradient
6051 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6053 vv(1)=pizda(1,1)+pizda(2,2)
6054 vv(2)=pizda(2,1)-pizda(1,2)
6055 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6056 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6057 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6064 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6065 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6066 cd write (2,*) 'ijkl',i,j,k,l
6067 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6068 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6070 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6071 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6072 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6073 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6075 if (j.lt.nres-1) then
6082 if (l.lt.nres-1) then
6092 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6094 ggg1(ll)=eel5*g_contij(ll,1)
6095 ggg2(ll)=eel5*g_contij(ll,2)
6096 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6097 ghalf=0.5d0*ggg1(ll)
6099 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6100 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6101 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6102 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6103 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6104 ghalf=0.5d0*ggg2(ll)
6106 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6107 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6108 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6109 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6114 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6115 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6120 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6121 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6127 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6132 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6136 cd write (2,*) iii,g_corr5_loc(iii)
6140 cd write (2,*) 'ekont',ekont
6141 cd write (iout,*) 'eello5',ekont*eel5
6144 c--------------------------------------------------------------------------
6145 double precision function eello6(i,j,k,l,jj,kk)
6146 implicit real*8 (a-h,o-z)
6147 include 'DIMENSIONS'
6148 include 'sizesclu.dat'
6149 include 'COMMON.IOUNITS'
6150 include 'COMMON.CHAIN'
6151 include 'COMMON.DERIV'
6152 include 'COMMON.INTERACT'
6153 include 'COMMON.CONTACTS'
6154 include 'COMMON.TORSION'
6155 include 'COMMON.VAR'
6156 include 'COMMON.GEO'
6157 include 'COMMON.FFIELD'
6158 double precision ggg1(3),ggg2(3)
6159 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6164 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6172 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6173 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6177 derx(lll,kkk,iii)=0.0d0
6181 cd eij=facont_hb(jj,i)
6182 cd ekl=facont_hb(kk,k)
6188 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6189 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6190 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6191 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6192 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6193 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6195 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6196 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6197 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6198 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6199 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6200 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6204 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6206 C If turn contributions are considered, they will be handled separately.
6207 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6208 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6209 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6210 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6211 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6212 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6213 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6216 if (j.lt.nres-1) then
6223 if (l.lt.nres-1) then
6231 ggg1(ll)=eel6*g_contij(ll,1)
6232 ggg2(ll)=eel6*g_contij(ll,2)
6233 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6234 ghalf=0.5d0*ggg1(ll)
6236 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6237 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6238 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6239 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6240 ghalf=0.5d0*ggg2(ll)
6241 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6243 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6244 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6245 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6246 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6251 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6252 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6257 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6258 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6264 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6269 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6273 cd write (2,*) iii,g_corr6_loc(iii)
6277 cd write (2,*) 'ekont',ekont
6278 cd write (iout,*) 'eello6',ekont*eel6
6281 c--------------------------------------------------------------------------
6282 double precision function eello6_graph1(i,j,k,l,imat,swap)
6283 implicit real*8 (a-h,o-z)
6284 include 'DIMENSIONS'
6285 include 'sizesclu.dat'
6286 include 'COMMON.IOUNITS'
6287 include 'COMMON.CHAIN'
6288 include 'COMMON.DERIV'
6289 include 'COMMON.INTERACT'
6290 include 'COMMON.CONTACTS'
6291 include 'COMMON.TORSION'
6292 include 'COMMON.VAR'
6293 include 'COMMON.GEO'
6294 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6298 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6300 C Parallel Antiparallel C
6306 C \ j|/k\| / \ |/k\|l / C
6311 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6312 itk=itortyp(itype(k))
6313 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6314 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6315 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6316 call transpose2(EUgC(1,1,k),auxmat(1,1))
6317 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6318 vv1(1)=pizda1(1,1)-pizda1(2,2)
6319 vv1(2)=pizda1(1,2)+pizda1(2,1)
6320 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6321 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6322 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6323 s5=scalar2(vv(1),Dtobr2(1,i))
6324 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6325 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6326 if (.not. calc_grad) return
6327 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6328 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6329 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6330 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6331 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6332 & +scalar2(vv(1),Dtobr2der(1,i)))
6333 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6334 vv1(1)=pizda1(1,1)-pizda1(2,2)
6335 vv1(2)=pizda1(1,2)+pizda1(2,1)
6336 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6337 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6339 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6340 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6341 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6342 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6343 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6345 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6346 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6347 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6348 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6349 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6351 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6352 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6353 vv1(1)=pizda1(1,1)-pizda1(2,2)
6354 vv1(2)=pizda1(1,2)+pizda1(2,1)
6355 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6356 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6357 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6358 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6367 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6368 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6369 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6370 call transpose2(EUgC(1,1,k),auxmat(1,1))
6371 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6373 vv1(1)=pizda1(1,1)-pizda1(2,2)
6374 vv1(2)=pizda1(1,2)+pizda1(2,1)
6375 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6376 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6377 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6378 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6379 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6380 s5=scalar2(vv(1),Dtobr2(1,i))
6381 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6387 c----------------------------------------------------------------------------
6388 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6389 implicit real*8 (a-h,o-z)
6390 include 'DIMENSIONS'
6391 include 'sizesclu.dat'
6392 include 'COMMON.IOUNITS'
6393 include 'COMMON.CHAIN'
6394 include 'COMMON.DERIV'
6395 include 'COMMON.INTERACT'
6396 include 'COMMON.CONTACTS'
6397 include 'COMMON.TORSION'
6398 include 'COMMON.VAR'
6399 include 'COMMON.GEO'
6401 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6402 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6405 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6407 C Parallel Antiparallel C
6413 C \ j|/k\| \ |/k\|l C
6418 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6419 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6420 C AL 7/4/01 s1 would occur in the sixth-order moment,
6421 C but not in a cluster cumulant
6423 s1=dip(1,jj,i)*dip(1,kk,k)
6425 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6426 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6427 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6428 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6429 call transpose2(EUg(1,1,k),auxmat(1,1))
6430 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6431 vv(1)=pizda(1,1)-pizda(2,2)
6432 vv(2)=pizda(1,2)+pizda(2,1)
6433 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6434 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6436 eello6_graph2=-(s1+s2+s3+s4)
6438 eello6_graph2=-(s2+s3+s4)
6441 if (.not. calc_grad) return
6442 C Derivatives in gamma(i-1)
6445 s1=dipderg(1,jj,i)*dip(1,kk,k)
6447 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6448 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6449 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6450 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6452 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6454 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6456 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6458 C Derivatives in gamma(k-1)
6460 s1=dip(1,jj,i)*dipderg(1,kk,k)
6462 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6463 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6464 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6465 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6466 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6467 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6468 vv(1)=pizda(1,1)-pizda(2,2)
6469 vv(2)=pizda(1,2)+pizda(2,1)
6470 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6472 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6474 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6476 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6477 C Derivatives in gamma(j-1) or gamma(l-1)
6480 s1=dipderg(3,jj,i)*dip(1,kk,k)
6482 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6483 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6484 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6485 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6486 vv(1)=pizda(1,1)-pizda(2,2)
6487 vv(2)=pizda(1,2)+pizda(2,1)
6488 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6491 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6493 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6496 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6497 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6499 C Derivatives in gamma(l-1) or gamma(j-1)
6502 s1=dip(1,jj,i)*dipderg(3,kk,k)
6504 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6505 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6506 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6507 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6508 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6509 vv(1)=pizda(1,1)-pizda(2,2)
6510 vv(2)=pizda(1,2)+pizda(2,1)
6511 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6514 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6516 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6519 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6520 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6522 C Cartesian derivatives.
6524 write (2,*) 'In eello6_graph2'
6526 write (2,*) 'iii=',iii
6528 write (2,*) 'kkk=',kkk
6530 write (2,'(3(2f10.5),5x)')
6531 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6541 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6543 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6546 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6548 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6549 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6551 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6552 call transpose2(EUg(1,1,k),auxmat(1,1))
6553 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6555 vv(1)=pizda(1,1)-pizda(2,2)
6556 vv(2)=pizda(1,2)+pizda(2,1)
6557 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6558 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6560 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6562 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6565 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6567 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6574 c----------------------------------------------------------------------------
6575 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6576 implicit real*8 (a-h,o-z)
6577 include 'DIMENSIONS'
6578 include 'sizesclu.dat'
6579 include 'COMMON.IOUNITS'
6580 include 'COMMON.CHAIN'
6581 include 'COMMON.DERIV'
6582 include 'COMMON.INTERACT'
6583 include 'COMMON.CONTACTS'
6584 include 'COMMON.TORSION'
6585 include 'COMMON.VAR'
6586 include 'COMMON.GEO'
6587 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6589 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6591 C Parallel Antiparallel C
6597 C j|/k\| / |/k\|l / C
6602 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6604 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6605 C energy moment and not to the cluster cumulant.
6606 iti=itortyp(itype(i))
6607 if (j.lt.nres-1) then
6608 itj1=itortyp(itype(j+1))
6612 itk=itortyp(itype(k))
6613 itk1=itortyp(itype(k+1))
6614 if (l.lt.nres-1) then
6615 itl1=itortyp(itype(l+1))
6620 s1=dip(4,jj,i)*dip(4,kk,k)
6622 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6623 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6624 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6625 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6626 call transpose2(EE(1,1,itk),auxmat(1,1))
6627 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6628 vv(1)=pizda(1,1)+pizda(2,2)
6629 vv(2)=pizda(2,1)-pizda(1,2)
6630 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6631 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6633 eello6_graph3=-(s1+s2+s3+s4)
6635 eello6_graph3=-(s2+s3+s4)
6638 if (.not. calc_grad) return
6639 C Derivatives in gamma(k-1)
6640 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6641 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6642 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6643 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6644 C Derivatives in gamma(l-1)
6645 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6646 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6647 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6648 vv(1)=pizda(1,1)+pizda(2,2)
6649 vv(2)=pizda(2,1)-pizda(1,2)
6650 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6651 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6652 C Cartesian derivatives.
6658 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6660 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6663 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6665 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6666 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6668 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6669 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6671 vv(1)=pizda(1,1)+pizda(2,2)
6672 vv(2)=pizda(2,1)-pizda(1,2)
6673 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6675 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6677 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6680 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6682 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6684 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6690 c----------------------------------------------------------------------------
6691 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6692 implicit real*8 (a-h,o-z)
6693 include 'DIMENSIONS'
6694 include 'sizesclu.dat'
6695 include 'COMMON.IOUNITS'
6696 include 'COMMON.CHAIN'
6697 include 'COMMON.DERIV'
6698 include 'COMMON.INTERACT'
6699 include 'COMMON.CONTACTS'
6700 include 'COMMON.TORSION'
6701 include 'COMMON.VAR'
6702 include 'COMMON.GEO'
6703 include 'COMMON.FFIELD'
6704 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6705 & auxvec1(2),auxmat1(2,2)
6707 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6709 C Parallel Antiparallel C
6715 C \ j|/k\| \ |/k\|l C
6720 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6722 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6723 C energy moment and not to the cluster cumulant.
6724 cd write (2,*) 'eello_graph4: wturn6',wturn6
6725 iti=itortyp(itype(i))
6726 itj=itortyp(itype(j))
6727 if (j.lt.nres-1) then
6728 itj1=itortyp(itype(j+1))
6732 itk=itortyp(itype(k))
6733 if (k.lt.nres-1) then
6734 itk1=itortyp(itype(k+1))
6738 itl=itortyp(itype(l))
6739 if (l.lt.nres-1) then
6740 itl1=itortyp(itype(l+1))
6744 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6745 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6746 cd & ' itl',itl,' itl1',itl1
6749 s1=dip(3,jj,i)*dip(3,kk,k)
6751 s1=dip(2,jj,j)*dip(2,kk,l)
6754 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6755 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6757 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6758 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6760 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6761 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6763 call transpose2(EUg(1,1,k),auxmat(1,1))
6764 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6765 vv(1)=pizda(1,1)-pizda(2,2)
6766 vv(2)=pizda(2,1)+pizda(1,2)
6767 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6768 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6770 eello6_graph4=-(s1+s2+s3+s4)
6772 eello6_graph4=-(s2+s3+s4)
6774 if (.not. calc_grad) return
6775 C Derivatives in gamma(i-1)
6779 s1=dipderg(2,jj,i)*dip(3,kk,k)
6781 s1=dipderg(4,jj,j)*dip(2,kk,l)
6784 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6786 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6787 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6789 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6790 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6792 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6793 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6794 cd write (2,*) 'turn6 derivatives'
6796 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6798 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6802 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6804 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6808 C Derivatives in gamma(k-1)
6811 s1=dip(3,jj,i)*dipderg(2,kk,k)
6813 s1=dip(2,jj,j)*dipderg(4,kk,l)
6816 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6817 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6819 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6820 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6822 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6823 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6825 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6826 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6827 vv(1)=pizda(1,1)-pizda(2,2)
6828 vv(2)=pizda(2,1)+pizda(1,2)
6829 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6830 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6832 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6834 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6838 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6840 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6843 C Derivatives in gamma(j-1) or gamma(l-1)
6844 if (l.eq.j+1 .and. l.gt.1) then
6845 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6846 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6847 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6848 vv(1)=pizda(1,1)-pizda(2,2)
6849 vv(2)=pizda(2,1)+pizda(1,2)
6850 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6851 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6852 else if (j.gt.1) then
6853 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6854 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6855 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6856 vv(1)=pizda(1,1)-pizda(2,2)
6857 vv(2)=pizda(2,1)+pizda(1,2)
6858 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6859 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6860 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6862 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6865 C Cartesian derivatives.
6872 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6874 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6878 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6880 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6884 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6886 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6888 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6889 & b1(1,itj1),auxvec(1))
6890 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6892 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6893 & b1(1,itl1),auxvec(1))
6894 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6896 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6898 vv(1)=pizda(1,1)-pizda(2,2)
6899 vv(2)=pizda(2,1)+pizda(1,2)
6900 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6902 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6904 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6907 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6910 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6913 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6915 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6917 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6921 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6923 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6926 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6928 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6936 c----------------------------------------------------------------------------
6937 double precision function eello_turn6(i,jj,kk)
6938 implicit real*8 (a-h,o-z)
6939 include 'DIMENSIONS'
6940 include 'sizesclu.dat'
6941 include 'COMMON.IOUNITS'
6942 include 'COMMON.CHAIN'
6943 include 'COMMON.DERIV'
6944 include 'COMMON.INTERACT'
6945 include 'COMMON.CONTACTS'
6946 include 'COMMON.TORSION'
6947 include 'COMMON.VAR'
6948 include 'COMMON.GEO'
6949 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6950 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6952 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6953 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6954 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6955 C the respective energy moment and not to the cluster cumulant.
6960 iti=itortyp(itype(i))
6961 itk=itortyp(itype(k))
6962 itk1=itortyp(itype(k+1))
6963 itl=itortyp(itype(l))
6964 itj=itortyp(itype(j))
6965 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6966 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6967 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6972 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6974 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6978 derx_turn(lll,kkk,iii)=0.0d0
6985 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6987 cd write (2,*) 'eello6_5',eello6_5
6989 call transpose2(AEA(1,1,1),auxmat(1,1))
6990 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
6991 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
6992 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
6996 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
6997 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
6998 s2 = scalar2(b1(1,itk),vtemp1(1))
7000 call transpose2(AEA(1,1,2),atemp(1,1))
7001 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7002 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7003 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7007 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7008 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7009 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7011 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7012 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7013 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7014 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7015 ss13 = scalar2(b1(1,itk),vtemp4(1))
7016 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7020 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7026 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7028 C Derivatives in gamma(i+2)
7030 call transpose2(AEA(1,1,1),auxmatd(1,1))
7031 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7032 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7033 call transpose2(AEAderg(1,1,2),atempd(1,1))
7034 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7035 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7039 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7040 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7041 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7047 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7048 C Derivatives in gamma(i+3)
7050 call transpose2(AEA(1,1,1),auxmatd(1,1))
7051 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7052 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7053 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7057 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7058 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7059 s2d = scalar2(b1(1,itk),vtemp1d(1))
7061 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7062 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7064 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7066 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7067 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7068 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7078 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7079 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7081 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7082 & -0.5d0*ekont*(s2d+s12d)
7084 C Derivatives in gamma(i+4)
7085 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7086 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7087 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7089 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7090 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7091 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7101 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7103 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7105 C Derivatives in gamma(i+5)
7107 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7108 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7109 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7113 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7114 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7115 s2d = scalar2(b1(1,itk),vtemp1d(1))
7117 call transpose2(AEA(1,1,2),atempd(1,1))
7118 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7119 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7123 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7124 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7126 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7127 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7128 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7138 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7139 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7141 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7142 & -0.5d0*ekont*(s2d+s12d)
7144 C Cartesian derivatives
7149 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7150 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7151 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7155 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7156 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7158 s2d = scalar2(b1(1,itk),vtemp1d(1))
7160 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7161 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7162 s8d = -(atempd(1,1)+atempd(2,2))*
7163 & scalar2(cc(1,1,itl),vtemp2(1))
7167 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7169 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7170 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7177 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7180 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7184 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7185 & - 0.5d0*(s8d+s12d)
7187 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7196 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7198 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7199 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7200 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7201 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7202 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7204 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7205 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7206 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7210 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7211 cd & 16*eel_turn6_num
7213 if (j.lt.nres-1) then
7220 if (l.lt.nres-1) then
7228 ggg1(ll)=eel_turn6*g_contij(ll,1)
7229 ggg2(ll)=eel_turn6*g_contij(ll,2)
7230 ghalf=0.5d0*ggg1(ll)
7232 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7233 & +ekont*derx_turn(ll,2,1)
7234 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7235 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7236 & +ekont*derx_turn(ll,4,1)
7237 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7238 ghalf=0.5d0*ggg2(ll)
7240 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7241 & +ekont*derx_turn(ll,2,2)
7242 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7243 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7244 & +ekont*derx_turn(ll,4,2)
7245 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7250 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7255 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7261 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7266 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7270 cd write (2,*) iii,g_corr6_loc(iii)
7273 eello_turn6=ekont*eel_turn6
7274 cd write (2,*) 'ekont',ekont
7275 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7278 crc-------------------------------------------------
7279 SUBROUTINE MATVEC2(A1,V1,V2)
7280 implicit real*8 (a-h,o-z)
7281 include 'DIMENSIONS'
7282 DIMENSION A1(2,2),V1(2),V2(2)
7286 c 3 VI=VI+A1(I,K)*V1(K)
7290 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7291 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7296 C---------------------------------------
7297 SUBROUTINE MATMAT2(A1,A2,A3)
7298 implicit real*8 (a-h,o-z)
7299 include 'DIMENSIONS'
7300 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7301 c DIMENSION AI3(2,2)
7305 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7311 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7312 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7313 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7314 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7322 c-------------------------------------------------------------------------
7323 double precision function scalar2(u,v)
7325 double precision u(2),v(2)
7328 scalar2=u(1)*v(1)+u(2)*v(2)
7332 C-----------------------------------------------------------------------------
7334 subroutine transpose2(a,at)
7336 double precision a(2,2),at(2,2)
7343 c--------------------------------------------------------------------------
7344 subroutine transpose(n,a,at)
7347 double precision a(n,n),at(n,n)
7355 C---------------------------------------------------------------------------
7356 subroutine prodmat3(a1,a2,kk,transp,prod)
7359 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7361 crc double precision auxmat(2,2),prod_(2,2)
7364 crc call transpose2(kk(1,1),auxmat(1,1))
7365 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7366 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7368 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7369 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7370 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7371 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7372 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7373 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7374 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7375 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7378 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7379 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7381 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7382 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7383 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7384 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7385 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7386 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7387 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7388 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7391 c call transpose2(a2(1,1),a2t(1,1))
7394 crc print *,((prod_(i,j),i=1,2),j=1,2)
7395 crc print *,((prod(i,j),i=1,2),j=1,2)
7399 C-----------------------------------------------------------------------------
7400 double precision function scalar(u,v)
7402 double precision u(3),v(3)