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
4512 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4514 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4515 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4516 c &gloc_sc(intertyp,i-3,icg)
4518 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4519 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4520 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4521 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4522 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4528 c------------------------------------------------------------------------------
4529 subroutine multibody(ecorr)
4530 C This subroutine calculates multi-body contributions to energy following
4531 C the idea of Skolnick et al. If side chains I and J make a contact and
4532 C at the same time side chains I+1 and J+1 make a contact, an extra
4533 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4534 implicit real*8 (a-h,o-z)
4535 include 'DIMENSIONS'
4536 include 'COMMON.IOUNITS'
4537 include 'COMMON.DERIV'
4538 include 'COMMON.INTERACT'
4539 include 'COMMON.CONTACTS'
4540 double precision gx(3),gx1(3)
4543 C Set lprn=.true. for debugging
4547 write (iout,'(a)') 'Contact function values:'
4549 write (iout,'(i2,20(1x,i2,f10.5))')
4550 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4565 num_conti=num_cont(i)
4566 num_conti1=num_cont(i1)
4571 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4572 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4573 cd & ' ishift=',ishift
4574 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4575 C The system gains extra energy.
4576 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4577 endif ! j1==j+-ishift
4586 c------------------------------------------------------------------------------
4587 double precision function esccorr(i,j,k,l,jj,kk)
4588 implicit real*8 (a-h,o-z)
4589 include 'DIMENSIONS'
4590 include 'COMMON.IOUNITS'
4591 include 'COMMON.DERIV'
4592 include 'COMMON.INTERACT'
4593 include 'COMMON.CONTACTS'
4594 double precision gx(3),gx1(3)
4599 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4600 C Calculate the multi-body contribution to energy.
4601 C Calculate multi-body contributions to the gradient.
4602 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4603 cd & k,l,(gacont(m,kk,k),m=1,3)
4605 gx(m) =ekl*gacont(m,jj,i)
4606 gx1(m)=eij*gacont(m,kk,k)
4607 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4608 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4609 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4610 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4614 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4619 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4625 c------------------------------------------------------------------------------
4627 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4628 implicit real*8 (a-h,o-z)
4629 include 'DIMENSIONS'
4630 integer dimen1,dimen2,atom,indx
4631 double precision buffer(dimen1,dimen2)
4632 double precision zapas
4633 common /contacts_hb/ zapas(3,20,maxres,7),
4634 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4635 & num_cont_hb(maxres),jcont_hb(20,maxres)
4636 num_kont=num_cont_hb(atom)
4640 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4643 buffer(i,indx+22)=facont_hb(i,atom)
4644 buffer(i,indx+23)=ees0p(i,atom)
4645 buffer(i,indx+24)=ees0m(i,atom)
4646 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4648 buffer(1,indx+26)=dfloat(num_kont)
4651 c------------------------------------------------------------------------------
4652 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4653 implicit real*8 (a-h,o-z)
4654 include 'DIMENSIONS'
4655 integer dimen1,dimen2,atom,indx
4656 double precision buffer(dimen1,dimen2)
4657 double precision zapas
4658 common /contacts_hb/ zapas(3,20,maxres,7),
4659 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4660 & num_cont_hb(maxres),jcont_hb(20,maxres)
4661 num_kont=buffer(1,indx+26)
4662 num_kont_old=num_cont_hb(atom)
4663 num_cont_hb(atom)=num_kont+num_kont_old
4668 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4671 facont_hb(ii,atom)=buffer(i,indx+22)
4672 ees0p(ii,atom)=buffer(i,indx+23)
4673 ees0m(ii,atom)=buffer(i,indx+24)
4674 jcont_hb(ii,atom)=buffer(i,indx+25)
4678 c------------------------------------------------------------------------------
4680 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4681 C This subroutine calculates multi-body contributions to hydrogen-bonding
4682 implicit real*8 (a-h,o-z)
4683 include 'DIMENSIONS'
4684 include 'sizesclu.dat'
4685 include 'COMMON.IOUNITS'
4687 include 'COMMON.INFO'
4689 include 'COMMON.FFIELD'
4690 include 'COMMON.DERIV'
4691 include 'COMMON.INTERACT'
4692 include 'COMMON.CONTACTS'
4694 parameter (max_cont=maxconts)
4695 parameter (max_dim=2*(8*3+2))
4696 parameter (msglen1=max_cont*max_dim*4)
4697 parameter (msglen2=2*msglen1)
4698 integer source,CorrelType,CorrelID,Error
4699 double precision buffer(max_cont,max_dim)
4701 double precision gx(3),gx1(3)
4704 C Set lprn=.true. for debugging
4709 if (fgProcs.le.1) goto 30
4711 write (iout,'(a)') 'Contact function values:'
4713 write (iout,'(2i3,50(1x,i2,f5.2))')
4714 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4715 & j=1,num_cont_hb(i))
4718 C Caution! Following code assumes that electrostatic interactions concerning
4719 C a given atom are split among at most two processors!
4729 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4732 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4733 if (MyRank.gt.0) then
4734 C Send correlation contributions to the preceding processor
4736 nn=num_cont_hb(iatel_s)
4737 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4738 cd write (iout,*) 'The BUFFER array:'
4740 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4742 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4744 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4745 C Clear the contacts of the atom passed to the neighboring processor
4746 nn=num_cont_hb(iatel_s+1)
4748 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4750 num_cont_hb(iatel_s)=0
4752 cd write (iout,*) 'Processor ',MyID,MyRank,
4753 cd & ' is sending correlation contribution to processor',MyID-1,
4754 cd & ' msglen=',msglen
4755 cd write (*,*) 'Processor ',MyID,MyRank,
4756 cd & ' is sending correlation contribution to processor',MyID-1,
4757 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4758 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4759 cd write (iout,*) 'Processor ',MyID,
4760 cd & ' has sent correlation contribution to processor',MyID-1,
4761 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4762 cd write (*,*) 'Processor ',MyID,
4763 cd & ' has sent correlation contribution to processor',MyID-1,
4764 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4766 endif ! (MyRank.gt.0)
4770 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4771 if (MyRank.lt.fgProcs-1) then
4772 C Receive correlation contributions from the next processor
4774 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4775 cd write (iout,*) 'Processor',MyID,
4776 cd & ' is receiving correlation contribution from processor',MyID+1,
4777 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4778 cd write (*,*) 'Processor',MyID,
4779 cd & ' is receiving correlation contribution from processor',MyID+1,
4780 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4782 do while (nbytes.le.0)
4783 call mp_probe(MyID+1,CorrelType,nbytes)
4785 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4786 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4787 cd write (iout,*) 'Processor',MyID,
4788 cd & ' has received correlation contribution from processor',MyID+1,
4789 cd & ' msglen=',msglen,' nbytes=',nbytes
4790 cd write (iout,*) 'The received BUFFER array:'
4792 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4794 if (msglen.eq.msglen1) then
4795 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4796 else if (msglen.eq.msglen2) then
4797 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4798 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4801 & 'ERROR!!!! message length changed while processing correlations.'
4803 & 'ERROR!!!! message length changed while processing correlations.'
4804 call mp_stopall(Error)
4805 endif ! msglen.eq.msglen1
4806 endif ! MyRank.lt.fgProcs-1
4813 write (iout,'(a)') 'Contact function values:'
4815 write (iout,'(2i3,50(1x,i2,f5.2))')
4816 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4817 & j=1,num_cont_hb(i))
4821 C Remove the loop below after debugging !!!
4828 C Calculate the local-electrostatic correlation terms
4829 do i=iatel_s,iatel_e+1
4831 num_conti=num_cont_hb(i)
4832 num_conti1=num_cont_hb(i+1)
4837 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4838 c & ' jj=',jj,' kk=',kk
4839 if (j1.eq.j+1 .or. j1.eq.j-1) then
4840 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4841 C The system gains extra energy.
4842 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4844 else if (j1.eq.j) then
4845 C Contacts I-J and I-(J+1) occur simultaneously.
4846 C The system loses extra energy.
4847 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4852 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4853 c & ' jj=',jj,' kk=',kk
4855 C Contacts I-J and (I+1)-J occur simultaneously.
4856 C The system loses extra energy.
4857 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4864 c------------------------------------------------------------------------------
4865 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4867 C This subroutine calculates multi-body contributions to hydrogen-bonding
4868 implicit real*8 (a-h,o-z)
4869 include 'DIMENSIONS'
4870 include 'sizesclu.dat'
4871 include 'COMMON.IOUNITS'
4873 include 'COMMON.INFO'
4875 include 'COMMON.FFIELD'
4876 include 'COMMON.DERIV'
4877 include 'COMMON.INTERACT'
4878 include 'COMMON.CONTACTS'
4880 parameter (max_cont=maxconts)
4881 parameter (max_dim=2*(8*3+2))
4882 parameter (msglen1=max_cont*max_dim*4)
4883 parameter (msglen2=2*msglen1)
4884 integer source,CorrelType,CorrelID,Error
4885 double precision buffer(max_cont,max_dim)
4887 double precision gx(3),gx1(3)
4890 C Set lprn=.true. for debugging
4897 if (fgProcs.le.1) goto 30
4899 write (iout,'(a)') 'Contact function values:'
4901 write (iout,'(2i3,50(1x,i2,f5.2))')
4902 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4903 & j=1,num_cont_hb(i))
4906 C Caution! Following code assumes that electrostatic interactions concerning
4907 C a given atom are split among at most two processors!
4917 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4920 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4921 if (MyRank.gt.0) then
4922 C Send correlation contributions to the preceding processor
4924 nn=num_cont_hb(iatel_s)
4925 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4926 cd write (iout,*) 'The BUFFER array:'
4928 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4930 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4932 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4933 C Clear the contacts of the atom passed to the neighboring processor
4934 nn=num_cont_hb(iatel_s+1)
4936 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4938 num_cont_hb(iatel_s)=0
4940 cd write (iout,*) 'Processor ',MyID,MyRank,
4941 cd & ' is sending correlation contribution to processor',MyID-1,
4942 cd & ' msglen=',msglen
4943 cd write (*,*) 'Processor ',MyID,MyRank,
4944 cd & ' is sending correlation contribution to processor',MyID-1,
4945 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4946 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4947 cd write (iout,*) 'Processor ',MyID,
4948 cd & ' has sent correlation contribution to processor',MyID-1,
4949 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4950 cd write (*,*) 'Processor ',MyID,
4951 cd & ' has sent correlation contribution to processor',MyID-1,
4952 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4954 endif ! (MyRank.gt.0)
4958 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4959 if (MyRank.lt.fgProcs-1) then
4960 C Receive correlation contributions from the next processor
4962 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4963 cd write (iout,*) 'Processor',MyID,
4964 cd & ' is receiving correlation contribution from processor',MyID+1,
4965 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4966 cd write (*,*) 'Processor',MyID,
4967 cd & ' is receiving correlation contribution from processor',MyID+1,
4968 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4970 do while (nbytes.le.0)
4971 call mp_probe(MyID+1,CorrelType,nbytes)
4973 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4974 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4975 cd write (iout,*) 'Processor',MyID,
4976 cd & ' has received correlation contribution from processor',MyID+1,
4977 cd & ' msglen=',msglen,' nbytes=',nbytes
4978 cd write (iout,*) 'The received BUFFER array:'
4980 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4982 if (msglen.eq.msglen1) then
4983 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4984 else if (msglen.eq.msglen2) then
4985 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4986 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4989 & 'ERROR!!!! message length changed while processing correlations.'
4991 & 'ERROR!!!! message length changed while processing correlations.'
4992 call mp_stopall(Error)
4993 endif ! msglen.eq.msglen1
4994 endif ! MyRank.lt.fgProcs-1
5001 write (iout,'(a)') 'Contact function values:'
5003 write (iout,'(2i3,50(1x,i2,f5.2))')
5004 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5005 & j=1,num_cont_hb(i))
5011 C Remove the loop below after debugging !!!
5018 C Calculate the dipole-dipole interaction energies
5019 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5020 do i=iatel_s,iatel_e+1
5021 num_conti=num_cont_hb(i)
5028 C Calculate the local-electrostatic correlation terms
5029 do i=iatel_s,iatel_e+1
5031 num_conti=num_cont_hb(i)
5032 num_conti1=num_cont_hb(i+1)
5037 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5038 c & ' jj=',jj,' kk=',kk
5039 if (j1.eq.j+1 .or. j1.eq.j-1) then
5040 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5041 C The system gains extra energy.
5043 sqd1=dsqrt(d_cont(jj,i))
5044 sqd2=dsqrt(d_cont(kk,i1))
5045 sred_geom = sqd1*sqd2
5046 IF (sred_geom.lt.cutoff_corr) THEN
5047 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5049 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5050 c & ' jj=',jj,' kk=',kk
5051 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5052 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5054 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5055 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5058 cd write (iout,*) 'sred_geom=',sred_geom,
5059 cd & ' ekont=',ekont,' fprim=',fprimcont
5060 call calc_eello(i,j,i+1,j1,jj,kk)
5061 if (wcorr4.gt.0.0d0)
5062 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5063 if (wcorr5.gt.0.0d0)
5064 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5065 c print *,"wcorr5",ecorr5
5066 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5067 cd write(2,*)'ijkl',i,j,i+1,j1
5068 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5069 & .or. wturn6.eq.0.0d0))then
5070 c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5071 c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5072 c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5073 c & 'ecorr6=',ecorr6, wcorr6
5074 cd write (iout,'(4e15.5)') sred_geom,
5075 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5076 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5077 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5078 else if (wturn6.gt.0.0d0
5079 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5080 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5081 eturn6=eturn6+eello_turn6(i,jj,kk)
5082 cd write (2,*) 'multibody_eello:eturn6',eturn6
5086 else if (j1.eq.j) then
5087 C Contacts I-J and I-(J+1) occur simultaneously.
5088 C The system loses extra energy.
5089 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5094 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5095 c & ' jj=',jj,' kk=',kk
5097 C Contacts I-J and (I+1)-J occur simultaneously.
5098 C The system loses extra energy.
5099 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5106 c------------------------------------------------------------------------------
5107 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5108 implicit real*8 (a-h,o-z)
5109 include 'DIMENSIONS'
5110 include 'COMMON.IOUNITS'
5111 include 'COMMON.DERIV'
5112 include 'COMMON.INTERACT'
5113 include 'COMMON.CONTACTS'
5114 double precision gx(3),gx1(3)
5124 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5125 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5126 C Following 4 lines for diagnostics.
5131 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5133 c write (iout,*)'Contacts have occurred for peptide groups',
5134 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5135 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5136 C Calculate the multi-body contribution to energy.
5137 ecorr=ecorr+ekont*ees
5139 C Calculate multi-body contributions to the gradient.
5141 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5142 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5143 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5144 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5145 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5146 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5147 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5148 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5149 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5150 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5151 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5152 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5153 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5154 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5158 gradcorr(ll,m)=gradcorr(ll,m)+
5159 & ees*ekl*gacont_hbr(ll,jj,i)-
5160 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5161 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5166 gradcorr(ll,m)=gradcorr(ll,m)+
5167 & ees*eij*gacont_hbr(ll,kk,k)-
5168 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5169 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5176 C---------------------------------------------------------------------------
5177 subroutine dipole(i,j,jj)
5178 implicit real*8 (a-h,o-z)
5179 include 'DIMENSIONS'
5180 include 'sizesclu.dat'
5181 include 'COMMON.IOUNITS'
5182 include 'COMMON.CHAIN'
5183 include 'COMMON.FFIELD'
5184 include 'COMMON.DERIV'
5185 include 'COMMON.INTERACT'
5186 include 'COMMON.CONTACTS'
5187 include 'COMMON.TORSION'
5188 include 'COMMON.VAR'
5189 include 'COMMON.GEO'
5190 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5192 iti1 = itortyp(itype(i+1))
5193 if (j.lt.nres-1) then
5194 itj1 = itortyp(itype(j+1))
5199 dipi(iii,1)=Ub2(iii,i)
5200 dipderi(iii)=Ub2der(iii,i)
5201 dipi(iii,2)=b1(iii,iti1)
5202 dipj(iii,1)=Ub2(iii,j)
5203 dipderj(iii)=Ub2der(iii,j)
5204 dipj(iii,2)=b1(iii,itj1)
5208 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5211 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5214 if (.not.calc_grad) return
5219 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5223 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5228 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5229 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5231 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5233 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5235 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5239 C---------------------------------------------------------------------------
5240 subroutine calc_eello(i,j,k,l,jj,kk)
5242 C This subroutine computes matrices and vectors needed to calculate
5243 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5245 implicit real*8 (a-h,o-z)
5246 include 'DIMENSIONS'
5247 include 'sizesclu.dat'
5248 include 'COMMON.IOUNITS'
5249 include 'COMMON.CHAIN'
5250 include 'COMMON.DERIV'
5251 include 'COMMON.INTERACT'
5252 include 'COMMON.CONTACTS'
5253 include 'COMMON.TORSION'
5254 include 'COMMON.VAR'
5255 include 'COMMON.GEO'
5256 include 'COMMON.FFIELD'
5257 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5258 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5261 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5262 cd & ' jj=',jj,' kk=',kk
5263 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5266 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5267 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5270 call transpose2(aa1(1,1),aa1t(1,1))
5271 call transpose2(aa2(1,1),aa2t(1,1))
5274 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5275 & aa1tder(1,1,lll,kkk))
5276 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5277 & aa2tder(1,1,lll,kkk))
5281 C parallel orientation of the two CA-CA-CA frames.
5283 iti=itortyp(itype(i))
5287 itk1=itortyp(itype(k+1))
5288 itj=itortyp(itype(j))
5289 if (l.lt.nres-1) then
5290 itl1=itortyp(itype(l+1))
5294 C A1 kernel(j+1) A2T
5296 cd write (iout,'(3f10.5,5x,3f10.5)')
5297 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5299 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5300 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5301 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5302 C Following matrices are needed only for 6-th order cumulants
5303 IF (wcorr6.gt.0.0d0) THEN
5304 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5305 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5306 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5307 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5308 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5309 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5310 & ADtEAderx(1,1,1,1,1,1))
5312 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5313 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5314 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5315 & ADtEA1derx(1,1,1,1,1,1))
5317 C End 6-th order cumulants
5320 cd write (2,*) 'In calc_eello6'
5322 cd write (2,*) 'iii=',iii
5324 cd write (2,*) 'kkk=',kkk
5326 cd write (2,'(3(2f10.5),5x)')
5327 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5332 call transpose2(EUgder(1,1,k),auxmat(1,1))
5333 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5334 call transpose2(EUg(1,1,k),auxmat(1,1))
5335 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5336 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5340 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5341 & EAEAderx(1,1,lll,kkk,iii,1))
5345 C A1T kernel(i+1) A2
5346 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5347 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5348 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5349 C Following matrices are needed only for 6-th order cumulants
5350 IF (wcorr6.gt.0.0d0) THEN
5351 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5352 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5353 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5354 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5355 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5356 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5357 & ADtEAderx(1,1,1,1,1,2))
5358 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5359 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5360 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5361 & ADtEA1derx(1,1,1,1,1,2))
5363 C End 6-th order cumulants
5364 call transpose2(EUgder(1,1,l),auxmat(1,1))
5365 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5366 call transpose2(EUg(1,1,l),auxmat(1,1))
5367 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5368 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5372 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5373 & EAEAderx(1,1,lll,kkk,iii,2))
5378 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5379 C They are needed only when the fifth- or the sixth-order cumulants are
5381 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5382 call transpose2(AEA(1,1,1),auxmat(1,1))
5383 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5384 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5385 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5386 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5387 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5388 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5389 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5390 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5391 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5392 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5393 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5394 call transpose2(AEA(1,1,2),auxmat(1,1))
5395 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5396 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5397 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5398 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5399 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5400 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5401 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5402 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5403 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5404 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5405 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5406 C Calculate the Cartesian derivatives of the vectors.
5410 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5411 call matvec2(auxmat(1,1),b1(1,iti),
5412 & AEAb1derx(1,lll,kkk,iii,1,1))
5413 call matvec2(auxmat(1,1),Ub2(1,i),
5414 & AEAb2derx(1,lll,kkk,iii,1,1))
5415 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5416 & AEAb1derx(1,lll,kkk,iii,2,1))
5417 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5418 & AEAb2derx(1,lll,kkk,iii,2,1))
5419 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5420 call matvec2(auxmat(1,1),b1(1,itj),
5421 & AEAb1derx(1,lll,kkk,iii,1,2))
5422 call matvec2(auxmat(1,1),Ub2(1,j),
5423 & AEAb2derx(1,lll,kkk,iii,1,2))
5424 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5425 & AEAb1derx(1,lll,kkk,iii,2,2))
5426 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5427 & AEAb2derx(1,lll,kkk,iii,2,2))
5434 C Antiparallel orientation of the two CA-CA-CA frames.
5436 iti=itortyp(itype(i))
5440 itk1=itortyp(itype(k+1))
5441 itl=itortyp(itype(l))
5442 itj=itortyp(itype(j))
5443 if (j.lt.nres-1) then
5444 itj1=itortyp(itype(j+1))
5448 C A2 kernel(j-1)T A1T
5449 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5450 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5451 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5452 C Following matrices are needed only for 6-th order cumulants
5453 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5454 & j.eq.i+4 .and. l.eq.i+3)) THEN
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.,EUgC(1,1,j),EUgCder(1,1,j),
5457 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5458 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5459 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5460 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5461 & ADtEAderx(1,1,1,1,1,1))
5462 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5463 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5464 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5465 & ADtEA1derx(1,1,1,1,1,1))
5467 C End 6-th order cumulants
5468 call transpose2(EUgder(1,1,k),auxmat(1,1))
5469 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5470 call transpose2(EUg(1,1,k),auxmat(1,1))
5471 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5472 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5476 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5477 & EAEAderx(1,1,lll,kkk,iii,1))
5481 C A2T kernel(i+1)T A1
5482 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5483 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5484 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5485 C Following matrices are needed only for 6-th order cumulants
5486 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5487 & j.eq.i+4 .and. l.eq.i+3)) THEN
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.,EUgC(1,1,k),EUgCder(1,1,k),
5490 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5491 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5492 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5493 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5494 & ADtEAderx(1,1,1,1,1,2))
5495 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5496 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5497 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5498 & ADtEA1derx(1,1,1,1,1,2))
5500 C End 6-th order cumulants
5501 call transpose2(EUgder(1,1,j),auxmat(1,1))
5502 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5503 call transpose2(EUg(1,1,j),auxmat(1,1))
5504 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5505 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5509 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5510 & EAEAderx(1,1,lll,kkk,iii,2))
5515 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5516 C They are needed only when the fifth- or the sixth-order cumulants are
5518 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5519 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5520 call transpose2(AEA(1,1,1),auxmat(1,1))
5521 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5522 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5523 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5524 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5525 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5526 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5527 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5528 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5529 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5530 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5531 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5532 call transpose2(AEA(1,1,2),auxmat(1,1))
5533 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5534 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5535 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5536 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5537 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5538 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5539 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5540 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5541 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5542 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5543 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5544 C Calculate the Cartesian derivatives of the vectors.
5548 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5549 call matvec2(auxmat(1,1),b1(1,iti),
5550 & AEAb1derx(1,lll,kkk,iii,1,1))
5551 call matvec2(auxmat(1,1),Ub2(1,i),
5552 & AEAb2derx(1,lll,kkk,iii,1,1))
5553 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5554 & AEAb1derx(1,lll,kkk,iii,2,1))
5555 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5556 & AEAb2derx(1,lll,kkk,iii,2,1))
5557 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5558 call matvec2(auxmat(1,1),b1(1,itl),
5559 & AEAb1derx(1,lll,kkk,iii,1,2))
5560 call matvec2(auxmat(1,1),Ub2(1,l),
5561 & AEAb2derx(1,lll,kkk,iii,1,2))
5562 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5563 & AEAb1derx(1,lll,kkk,iii,2,2))
5564 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5565 & AEAb2derx(1,lll,kkk,iii,2,2))
5574 C---------------------------------------------------------------------------
5575 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5576 & KK,KKderg,AKA,AKAderg,AKAderx)
5580 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5581 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5582 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5587 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5589 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5592 cd if (lprn) write (2,*) 'In kernel'
5594 cd if (lprn) write (2,*) 'kkk=',kkk
5596 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5597 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5599 cd write (2,*) 'lll=',lll
5600 cd write (2,*) 'iii=1'
5602 cd write (2,'(3(2f10.5),5x)')
5603 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5606 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5607 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5609 cd write (2,*) 'lll=',lll
5610 cd write (2,*) 'iii=2'
5612 cd write (2,'(3(2f10.5),5x)')
5613 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5620 C---------------------------------------------------------------------------
5621 double precision function eello4(i,j,k,l,jj,kk)
5622 implicit real*8 (a-h,o-z)
5623 include 'DIMENSIONS'
5624 include 'sizesclu.dat'
5625 include 'COMMON.IOUNITS'
5626 include 'COMMON.CHAIN'
5627 include 'COMMON.DERIV'
5628 include 'COMMON.INTERACT'
5629 include 'COMMON.CONTACTS'
5630 include 'COMMON.TORSION'
5631 include 'COMMON.VAR'
5632 include 'COMMON.GEO'
5633 double precision pizda(2,2),ggg1(3),ggg2(3)
5634 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5638 cd print *,'eello4:',i,j,k,l,jj,kk
5639 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5640 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5641 cold eij=facont_hb(jj,i)
5642 cold ekl=facont_hb(kk,k)
5644 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5646 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5647 gcorr_loc(k-1)=gcorr_loc(k-1)
5648 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5650 gcorr_loc(l-1)=gcorr_loc(l-1)
5651 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5653 gcorr_loc(j-1)=gcorr_loc(j-1)
5654 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5659 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5660 & -EAEAderx(2,2,lll,kkk,iii,1)
5661 cd derx(lll,kkk,iii)=0.0d0
5665 cd gcorr_loc(l-1)=0.0d0
5666 cd gcorr_loc(j-1)=0.0d0
5667 cd gcorr_loc(k-1)=0.0d0
5669 cd write (iout,*)'Contacts have occurred for peptide groups',
5670 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5671 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5672 if (j.lt.nres-1) then
5679 if (l.lt.nres-1) then
5687 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5688 ggg1(ll)=eel4*g_contij(ll,1)
5689 ggg2(ll)=eel4*g_contij(ll,2)
5690 ghalf=0.5d0*ggg1(ll)
5692 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5693 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5694 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5695 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5696 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5697 ghalf=0.5d0*ggg2(ll)
5699 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5700 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5701 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5702 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5707 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5708 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5713 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5714 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5720 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5725 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5729 cd write (2,*) iii,gcorr_loc(iii)
5733 cd write (2,*) 'ekont',ekont
5734 cd write (iout,*) 'eello4',ekont*eel4
5737 C---------------------------------------------------------------------------
5738 double precision function eello5(i,j,k,l,jj,kk)
5739 implicit real*8 (a-h,o-z)
5740 include 'DIMENSIONS'
5741 include 'sizesclu.dat'
5742 include 'COMMON.IOUNITS'
5743 include 'COMMON.CHAIN'
5744 include 'COMMON.DERIV'
5745 include 'COMMON.INTERACT'
5746 include 'COMMON.CONTACTS'
5747 include 'COMMON.TORSION'
5748 include 'COMMON.VAR'
5749 include 'COMMON.GEO'
5750 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5751 double precision ggg1(3),ggg2(3)
5752 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5757 C /l\ / \ \ / \ / \ / C
5758 C / \ / \ \ / \ / \ / C
5759 C j| o |l1 | o | o| o | | o |o C
5760 C \ |/k\| |/ \| / |/ \| |/ \| C
5761 C \i/ \ / \ / / \ / \ C
5763 C (I) (II) (III) (IV) C
5765 C eello5_1 eello5_2 eello5_3 eello5_4 C
5767 C Antiparallel chains C
5770 C /j\ / \ \ / \ / \ / C
5771 C / \ / \ \ / \ / \ / C
5772 C j1| o |l | o | o| o | | o |o C
5773 C \ |/k\| |/ \| / |/ \| |/ \| C
5774 C \i/ \ / \ / / \ / \ C
5776 C (I) (II) (III) (IV) C
5778 C eello5_1 eello5_2 eello5_3 eello5_4 C
5780 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5782 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5783 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5788 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5790 itk=itortyp(itype(k))
5791 itl=itortyp(itype(l))
5792 itj=itortyp(itype(j))
5797 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5798 cd & eel5_3_num,eel5_4_num)
5802 derx(lll,kkk,iii)=0.0d0
5806 cd eij=facont_hb(jj,i)
5807 cd ekl=facont_hb(kk,k)
5809 cd write (iout,*)'Contacts have occurred for peptide groups',
5810 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5812 C Contribution from the graph I.
5813 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5814 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5815 call transpose2(EUg(1,1,k),auxmat(1,1))
5816 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5817 vv(1)=pizda(1,1)-pizda(2,2)
5818 vv(2)=pizda(1,2)+pizda(2,1)
5819 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5820 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5822 C Explicit gradient in virtual-dihedral angles.
5823 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5824 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5825 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5826 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5827 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5828 vv(1)=pizda(1,1)-pizda(2,2)
5829 vv(2)=pizda(1,2)+pizda(2,1)
5830 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5831 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5832 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5833 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5834 vv(1)=pizda(1,1)-pizda(2,2)
5835 vv(2)=pizda(1,2)+pizda(2,1)
5837 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5838 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5839 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5841 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5842 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5843 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5845 C Cartesian gradient
5849 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5851 vv(1)=pizda(1,1)-pizda(2,2)
5852 vv(2)=pizda(1,2)+pizda(2,1)
5853 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5854 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5855 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5862 C Contribution from graph II
5863 call transpose2(EE(1,1,itk),auxmat(1,1))
5864 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5865 vv(1)=pizda(1,1)+pizda(2,2)
5866 vv(2)=pizda(2,1)-pizda(1,2)
5867 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5868 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5870 C Explicit gradient in virtual-dihedral angles.
5871 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5872 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5873 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5874 vv(1)=pizda(1,1)+pizda(2,2)
5875 vv(2)=pizda(2,1)-pizda(1,2)
5877 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5878 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5879 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5881 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5882 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5883 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5885 C Cartesian gradient
5889 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5891 vv(1)=pizda(1,1)+pizda(2,2)
5892 vv(2)=pizda(2,1)-pizda(1,2)
5893 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5894 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5895 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5904 C Parallel orientation
5905 C Contribution from graph III
5906 call transpose2(EUg(1,1,l),auxmat(1,1))
5907 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5908 vv(1)=pizda(1,1)-pizda(2,2)
5909 vv(2)=pizda(1,2)+pizda(2,1)
5910 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5911 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5913 C Explicit gradient in virtual-dihedral angles.
5914 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5915 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5916 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5917 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5918 vv(1)=pizda(1,1)-pizda(2,2)
5919 vv(2)=pizda(1,2)+pizda(2,1)
5920 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5921 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5922 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5923 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5924 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5925 vv(1)=pizda(1,1)-pizda(2,2)
5926 vv(2)=pizda(1,2)+pizda(2,1)
5927 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5928 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5929 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5930 C Cartesian gradient
5934 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5936 vv(1)=pizda(1,1)-pizda(2,2)
5937 vv(2)=pizda(1,2)+pizda(2,1)
5938 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5939 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5940 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5946 C Contribution from graph IV
5948 call transpose2(EE(1,1,itl),auxmat(1,1))
5949 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5950 vv(1)=pizda(1,1)+pizda(2,2)
5951 vv(2)=pizda(2,1)-pizda(1,2)
5952 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5953 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5955 C Explicit gradient in virtual-dihedral angles.
5956 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5957 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5958 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5959 vv(1)=pizda(1,1)+pizda(2,2)
5960 vv(2)=pizda(2,1)-pizda(1,2)
5961 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5962 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5963 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5964 C Cartesian gradient
5968 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5970 vv(1)=pizda(1,1)+pizda(2,2)
5971 vv(2)=pizda(2,1)-pizda(1,2)
5972 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5973 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5974 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5980 C Antiparallel orientation
5981 C Contribution from graph III
5983 call transpose2(EUg(1,1,j),auxmat(1,1))
5984 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5985 vv(1)=pizda(1,1)-pizda(2,2)
5986 vv(2)=pizda(1,2)+pizda(2,1)
5987 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
5988 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5990 C Explicit gradient in virtual-dihedral angles.
5991 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5992 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
5993 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
5994 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5995 vv(1)=pizda(1,1)-pizda(2,2)
5996 vv(2)=pizda(1,2)+pizda(2,1)
5997 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5998 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
5999 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6000 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6001 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6002 vv(1)=pizda(1,1)-pizda(2,2)
6003 vv(2)=pizda(1,2)+pizda(2,1)
6004 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6005 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6006 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6007 C Cartesian gradient
6011 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6013 vv(1)=pizda(1,1)-pizda(2,2)
6014 vv(2)=pizda(1,2)+pizda(2,1)
6015 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6016 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6017 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6023 C Contribution from graph IV
6025 call transpose2(EE(1,1,itj),auxmat(1,1))
6026 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6027 vv(1)=pizda(1,1)+pizda(2,2)
6028 vv(2)=pizda(2,1)-pizda(1,2)
6029 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6030 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6032 C Explicit gradient in virtual-dihedral angles.
6033 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6034 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6035 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6036 vv(1)=pizda(1,1)+pizda(2,2)
6037 vv(2)=pizda(2,1)-pizda(1,2)
6038 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6039 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6040 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6041 C Cartesian gradient
6045 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6047 vv(1)=pizda(1,1)+pizda(2,2)
6048 vv(2)=pizda(2,1)-pizda(1,2)
6049 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6050 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6051 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6058 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6059 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6060 cd write (2,*) 'ijkl',i,j,k,l
6061 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6062 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6064 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6065 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6066 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6067 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6069 if (j.lt.nres-1) then
6076 if (l.lt.nres-1) then
6086 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6088 ggg1(ll)=eel5*g_contij(ll,1)
6089 ggg2(ll)=eel5*g_contij(ll,2)
6090 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6091 ghalf=0.5d0*ggg1(ll)
6093 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6094 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6095 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6096 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6097 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6098 ghalf=0.5d0*ggg2(ll)
6100 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6101 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6102 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6103 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6108 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6109 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6114 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6115 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6121 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6126 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6130 cd write (2,*) iii,g_corr5_loc(iii)
6134 cd write (2,*) 'ekont',ekont
6135 cd write (iout,*) 'eello5',ekont*eel5
6138 c--------------------------------------------------------------------------
6139 double precision function eello6(i,j,k,l,jj,kk)
6140 implicit real*8 (a-h,o-z)
6141 include 'DIMENSIONS'
6142 include 'sizesclu.dat'
6143 include 'COMMON.IOUNITS'
6144 include 'COMMON.CHAIN'
6145 include 'COMMON.DERIV'
6146 include 'COMMON.INTERACT'
6147 include 'COMMON.CONTACTS'
6148 include 'COMMON.TORSION'
6149 include 'COMMON.VAR'
6150 include 'COMMON.GEO'
6151 include 'COMMON.FFIELD'
6152 double precision ggg1(3),ggg2(3)
6153 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6158 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6166 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6167 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6171 derx(lll,kkk,iii)=0.0d0
6175 cd eij=facont_hb(jj,i)
6176 cd ekl=facont_hb(kk,k)
6182 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6183 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6184 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6185 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6186 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6187 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6189 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6190 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6191 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6192 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6193 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6194 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6198 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6200 C If turn contributions are considered, they will be handled separately.
6201 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6202 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6203 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6204 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6205 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6206 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6207 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6210 if (j.lt.nres-1) then
6217 if (l.lt.nres-1) then
6225 ggg1(ll)=eel6*g_contij(ll,1)
6226 ggg2(ll)=eel6*g_contij(ll,2)
6227 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6228 ghalf=0.5d0*ggg1(ll)
6230 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6231 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6232 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6233 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6234 ghalf=0.5d0*ggg2(ll)
6235 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6237 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6238 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6239 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6240 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6245 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6246 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6251 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6252 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6258 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6263 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6267 cd write (2,*) iii,g_corr6_loc(iii)
6271 cd write (2,*) 'ekont',ekont
6272 cd write (iout,*) 'eello6',ekont*eel6
6275 c--------------------------------------------------------------------------
6276 double precision function eello6_graph1(i,j,k,l,imat,swap)
6277 implicit real*8 (a-h,o-z)
6278 include 'DIMENSIONS'
6279 include 'sizesclu.dat'
6280 include 'COMMON.IOUNITS'
6281 include 'COMMON.CHAIN'
6282 include 'COMMON.DERIV'
6283 include 'COMMON.INTERACT'
6284 include 'COMMON.CONTACTS'
6285 include 'COMMON.TORSION'
6286 include 'COMMON.VAR'
6287 include 'COMMON.GEO'
6288 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6292 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6294 C Parallel Antiparallel C
6300 C \ j|/k\| / \ |/k\|l / C
6305 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6306 itk=itortyp(itype(k))
6307 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6308 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6309 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6310 call transpose2(EUgC(1,1,k),auxmat(1,1))
6311 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6312 vv1(1)=pizda1(1,1)-pizda1(2,2)
6313 vv1(2)=pizda1(1,2)+pizda1(2,1)
6314 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6315 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6316 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6317 s5=scalar2(vv(1),Dtobr2(1,i))
6318 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6319 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6320 if (.not. calc_grad) return
6321 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6322 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6323 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6324 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6325 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6326 & +scalar2(vv(1),Dtobr2der(1,i)))
6327 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6328 vv1(1)=pizda1(1,1)-pizda1(2,2)
6329 vv1(2)=pizda1(1,2)+pizda1(2,1)
6330 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6331 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6333 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6334 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6335 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6336 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6337 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6339 g_corr6_loc(j-1)=g_corr6_loc(j-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 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6346 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6347 vv1(1)=pizda1(1,1)-pizda1(2,2)
6348 vv1(2)=pizda1(1,2)+pizda1(2,1)
6349 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6350 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6351 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6352 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6361 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6362 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6363 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6364 call transpose2(EUgC(1,1,k),auxmat(1,1))
6365 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6367 vv1(1)=pizda1(1,1)-pizda1(2,2)
6368 vv1(2)=pizda1(1,2)+pizda1(2,1)
6369 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6370 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6371 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6372 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6373 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6374 s5=scalar2(vv(1),Dtobr2(1,i))
6375 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6381 c----------------------------------------------------------------------------
6382 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6383 implicit real*8 (a-h,o-z)
6384 include 'DIMENSIONS'
6385 include 'sizesclu.dat'
6386 include 'COMMON.IOUNITS'
6387 include 'COMMON.CHAIN'
6388 include 'COMMON.DERIV'
6389 include 'COMMON.INTERACT'
6390 include 'COMMON.CONTACTS'
6391 include 'COMMON.TORSION'
6392 include 'COMMON.VAR'
6393 include 'COMMON.GEO'
6395 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6396 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6399 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6401 C Parallel Antiparallel C
6407 C \ j|/k\| \ |/k\|l C
6412 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6413 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6414 C AL 7/4/01 s1 would occur in the sixth-order moment,
6415 C but not in a cluster cumulant
6417 s1=dip(1,jj,i)*dip(1,kk,k)
6419 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6420 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6421 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6422 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6423 call transpose2(EUg(1,1,k),auxmat(1,1))
6424 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6425 vv(1)=pizda(1,1)-pizda(2,2)
6426 vv(2)=pizda(1,2)+pizda(2,1)
6427 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6428 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6430 eello6_graph2=-(s1+s2+s3+s4)
6432 eello6_graph2=-(s2+s3+s4)
6435 if (.not. calc_grad) return
6436 C Derivatives in gamma(i-1)
6439 s1=dipderg(1,jj,i)*dip(1,kk,k)
6441 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6442 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6443 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6444 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6446 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6448 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6450 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6452 C Derivatives in gamma(k-1)
6454 s1=dip(1,jj,i)*dipderg(1,kk,k)
6456 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6457 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6458 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6459 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6460 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6461 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6462 vv(1)=pizda(1,1)-pizda(2,2)
6463 vv(2)=pizda(1,2)+pizda(2,1)
6464 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6466 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6468 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6470 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6471 C Derivatives in gamma(j-1) or gamma(l-1)
6474 s1=dipderg(3,jj,i)*dip(1,kk,k)
6476 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6477 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6478 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6479 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6480 vv(1)=pizda(1,1)-pizda(2,2)
6481 vv(2)=pizda(1,2)+pizda(2,1)
6482 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6485 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6487 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6490 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6491 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6493 C Derivatives in gamma(l-1) or gamma(j-1)
6496 s1=dip(1,jj,i)*dipderg(3,kk,k)
6498 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6499 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6500 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6501 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6502 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6503 vv(1)=pizda(1,1)-pizda(2,2)
6504 vv(2)=pizda(1,2)+pizda(2,1)
6505 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6508 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6510 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6513 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6514 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6516 C Cartesian derivatives.
6518 write (2,*) 'In eello6_graph2'
6520 write (2,*) 'iii=',iii
6522 write (2,*) 'kkk=',kkk
6524 write (2,'(3(2f10.5),5x)')
6525 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6535 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6537 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6540 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6542 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6543 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6545 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6546 call transpose2(EUg(1,1,k),auxmat(1,1))
6547 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6549 vv(1)=pizda(1,1)-pizda(2,2)
6550 vv(2)=pizda(1,2)+pizda(2,1)
6551 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6552 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6554 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6556 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6559 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6561 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6568 c----------------------------------------------------------------------------
6569 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6570 implicit real*8 (a-h,o-z)
6571 include 'DIMENSIONS'
6572 include 'sizesclu.dat'
6573 include 'COMMON.IOUNITS'
6574 include 'COMMON.CHAIN'
6575 include 'COMMON.DERIV'
6576 include 'COMMON.INTERACT'
6577 include 'COMMON.CONTACTS'
6578 include 'COMMON.TORSION'
6579 include 'COMMON.VAR'
6580 include 'COMMON.GEO'
6581 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6583 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6585 C Parallel Antiparallel C
6591 C j|/k\| / |/k\|l / C
6596 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6598 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6599 C energy moment and not to the cluster cumulant.
6600 iti=itortyp(itype(i))
6601 if (j.lt.nres-1) then
6602 itj1=itortyp(itype(j+1))
6606 itk=itortyp(itype(k))
6607 itk1=itortyp(itype(k+1))
6608 if (l.lt.nres-1) then
6609 itl1=itortyp(itype(l+1))
6614 s1=dip(4,jj,i)*dip(4,kk,k)
6616 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6617 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6618 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6619 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6620 call transpose2(EE(1,1,itk),auxmat(1,1))
6621 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6622 vv(1)=pizda(1,1)+pizda(2,2)
6623 vv(2)=pizda(2,1)-pizda(1,2)
6624 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6625 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6627 eello6_graph3=-(s1+s2+s3+s4)
6629 eello6_graph3=-(s2+s3+s4)
6632 if (.not. calc_grad) return
6633 C Derivatives in gamma(k-1)
6634 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6635 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6636 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6637 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6638 C Derivatives in gamma(l-1)
6639 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6640 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6641 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6642 vv(1)=pizda(1,1)+pizda(2,2)
6643 vv(2)=pizda(2,1)-pizda(1,2)
6644 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6645 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6646 C Cartesian derivatives.
6652 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6654 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6657 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6659 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6660 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6662 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6663 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6665 vv(1)=pizda(1,1)+pizda(2,2)
6666 vv(2)=pizda(2,1)-pizda(1,2)
6667 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6669 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6671 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6674 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6676 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6678 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6684 c----------------------------------------------------------------------------
6685 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6686 implicit real*8 (a-h,o-z)
6687 include 'DIMENSIONS'
6688 include 'sizesclu.dat'
6689 include 'COMMON.IOUNITS'
6690 include 'COMMON.CHAIN'
6691 include 'COMMON.DERIV'
6692 include 'COMMON.INTERACT'
6693 include 'COMMON.CONTACTS'
6694 include 'COMMON.TORSION'
6695 include 'COMMON.VAR'
6696 include 'COMMON.GEO'
6697 include 'COMMON.FFIELD'
6698 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6699 & auxvec1(2),auxmat1(2,2)
6701 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6703 C Parallel Antiparallel C
6709 C \ j|/k\| \ |/k\|l C
6714 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6716 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6717 C energy moment and not to the cluster cumulant.
6718 cd write (2,*) 'eello_graph4: wturn6',wturn6
6719 iti=itortyp(itype(i))
6720 itj=itortyp(itype(j))
6721 if (j.lt.nres-1) then
6722 itj1=itortyp(itype(j+1))
6726 itk=itortyp(itype(k))
6727 if (k.lt.nres-1) then
6728 itk1=itortyp(itype(k+1))
6732 itl=itortyp(itype(l))
6733 if (l.lt.nres-1) then
6734 itl1=itortyp(itype(l+1))
6738 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6739 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6740 cd & ' itl',itl,' itl1',itl1
6743 s1=dip(3,jj,i)*dip(3,kk,k)
6745 s1=dip(2,jj,j)*dip(2,kk,l)
6748 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6749 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6751 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6752 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6754 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6755 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6757 call transpose2(EUg(1,1,k),auxmat(1,1))
6758 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6759 vv(1)=pizda(1,1)-pizda(2,2)
6760 vv(2)=pizda(2,1)+pizda(1,2)
6761 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6762 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6764 eello6_graph4=-(s1+s2+s3+s4)
6766 eello6_graph4=-(s2+s3+s4)
6768 if (.not. calc_grad) return
6769 C Derivatives in gamma(i-1)
6773 s1=dipderg(2,jj,i)*dip(3,kk,k)
6775 s1=dipderg(4,jj,j)*dip(2,kk,l)
6778 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6780 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6781 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6783 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6784 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6786 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6787 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6788 cd write (2,*) 'turn6 derivatives'
6790 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6792 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6796 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6798 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6802 C Derivatives in gamma(k-1)
6805 s1=dip(3,jj,i)*dipderg(2,kk,k)
6807 s1=dip(2,jj,j)*dipderg(4,kk,l)
6810 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6811 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6813 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6814 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6816 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6817 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6819 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6820 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6821 vv(1)=pizda(1,1)-pizda(2,2)
6822 vv(2)=pizda(2,1)+pizda(1,2)
6823 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6824 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6826 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6828 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6832 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6834 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6837 C Derivatives in gamma(j-1) or gamma(l-1)
6838 if (l.eq.j+1 .and. l.gt.1) then
6839 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6840 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6841 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6842 vv(1)=pizda(1,1)-pizda(2,2)
6843 vv(2)=pizda(2,1)+pizda(1,2)
6844 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6845 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6846 else if (j.gt.1) then
6847 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6848 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6849 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6850 vv(1)=pizda(1,1)-pizda(2,2)
6851 vv(2)=pizda(2,1)+pizda(1,2)
6852 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6853 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6854 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6856 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6859 C Cartesian derivatives.
6866 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6868 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6872 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6874 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6878 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6880 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6882 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6883 & b1(1,itj1),auxvec(1))
6884 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6886 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6887 & b1(1,itl1),auxvec(1))
6888 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6890 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6892 vv(1)=pizda(1,1)-pizda(2,2)
6893 vv(2)=pizda(2,1)+pizda(1,2)
6894 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6896 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6898 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6901 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6904 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6907 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6909 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6911 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6915 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6917 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6920 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6922 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6930 c----------------------------------------------------------------------------
6931 double precision function eello_turn6(i,jj,kk)
6932 implicit real*8 (a-h,o-z)
6933 include 'DIMENSIONS'
6934 include 'sizesclu.dat'
6935 include 'COMMON.IOUNITS'
6936 include 'COMMON.CHAIN'
6937 include 'COMMON.DERIV'
6938 include 'COMMON.INTERACT'
6939 include 'COMMON.CONTACTS'
6940 include 'COMMON.TORSION'
6941 include 'COMMON.VAR'
6942 include 'COMMON.GEO'
6943 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6944 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6946 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6947 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6948 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6949 C the respective energy moment and not to the cluster cumulant.
6954 iti=itortyp(itype(i))
6955 itk=itortyp(itype(k))
6956 itk1=itortyp(itype(k+1))
6957 itl=itortyp(itype(l))
6958 itj=itortyp(itype(j))
6959 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6960 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6961 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6966 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6968 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6972 derx_turn(lll,kkk,iii)=0.0d0
6979 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6981 cd write (2,*) 'eello6_5',eello6_5
6983 call transpose2(AEA(1,1,1),auxmat(1,1))
6984 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
6985 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
6986 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
6990 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
6991 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
6992 s2 = scalar2(b1(1,itk),vtemp1(1))
6994 call transpose2(AEA(1,1,2),atemp(1,1))
6995 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
6996 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
6997 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7001 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7002 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7003 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7005 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7006 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7007 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7008 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7009 ss13 = scalar2(b1(1,itk),vtemp4(1))
7010 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7014 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7020 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7022 C Derivatives in gamma(i+2)
7024 call transpose2(AEA(1,1,1),auxmatd(1,1))
7025 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7026 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7027 call transpose2(AEAderg(1,1,2),atempd(1,1))
7028 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7029 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7033 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7034 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7035 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7041 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7042 C Derivatives in gamma(i+3)
7044 call transpose2(AEA(1,1,1),auxmatd(1,1))
7045 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7046 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7047 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7051 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7052 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7053 s2d = scalar2(b1(1,itk),vtemp1d(1))
7055 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7056 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7058 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7060 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7061 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7062 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7072 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7073 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7075 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7076 & -0.5d0*ekont*(s2d+s12d)
7078 C Derivatives in gamma(i+4)
7079 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7080 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7081 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7083 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7084 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7085 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7095 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7097 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7099 C Derivatives in gamma(i+5)
7101 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7102 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7103 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7107 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7108 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7109 s2d = scalar2(b1(1,itk),vtemp1d(1))
7111 call transpose2(AEA(1,1,2),atempd(1,1))
7112 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7113 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7117 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7118 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7120 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7121 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7122 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7132 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7133 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7135 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7136 & -0.5d0*ekont*(s2d+s12d)
7138 C Cartesian derivatives
7143 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7144 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7145 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7149 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7150 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7152 s2d = scalar2(b1(1,itk),vtemp1d(1))
7154 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7155 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7156 s8d = -(atempd(1,1)+atempd(2,2))*
7157 & scalar2(cc(1,1,itl),vtemp2(1))
7161 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7163 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7164 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7171 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7174 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7178 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7179 & - 0.5d0*(s8d+s12d)
7181 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7190 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7192 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7193 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7194 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7195 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7196 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7198 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7199 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7200 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7204 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7205 cd & 16*eel_turn6_num
7207 if (j.lt.nres-1) then
7214 if (l.lt.nres-1) then
7222 ggg1(ll)=eel_turn6*g_contij(ll,1)
7223 ggg2(ll)=eel_turn6*g_contij(ll,2)
7224 ghalf=0.5d0*ggg1(ll)
7226 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7227 & +ekont*derx_turn(ll,2,1)
7228 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7229 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7230 & +ekont*derx_turn(ll,4,1)
7231 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7232 ghalf=0.5d0*ggg2(ll)
7234 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7235 & +ekont*derx_turn(ll,2,2)
7236 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7237 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7238 & +ekont*derx_turn(ll,4,2)
7239 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7244 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7249 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7255 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7260 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7264 cd write (2,*) iii,g_corr6_loc(iii)
7267 eello_turn6=ekont*eel_turn6
7268 cd write (2,*) 'ekont',ekont
7269 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7272 crc-------------------------------------------------
7273 SUBROUTINE MATVEC2(A1,V1,V2)
7274 implicit real*8 (a-h,o-z)
7275 include 'DIMENSIONS'
7276 DIMENSION A1(2,2),V1(2),V2(2)
7280 c 3 VI=VI+A1(I,K)*V1(K)
7284 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7285 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7290 C---------------------------------------
7291 SUBROUTINE MATMAT2(A1,A2,A3)
7292 implicit real*8 (a-h,o-z)
7293 include 'DIMENSIONS'
7294 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7295 c DIMENSION AI3(2,2)
7299 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7305 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7306 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7307 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7308 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7316 c-------------------------------------------------------------------------
7317 double precision function scalar2(u,v)
7319 double precision u(2),v(2)
7322 scalar2=u(1)*v(1)+u(2)*v(2)
7326 C-----------------------------------------------------------------------------
7328 subroutine transpose2(a,at)
7330 double precision a(2,2),at(2,2)
7337 c--------------------------------------------------------------------------
7338 subroutine transpose(n,a,at)
7341 double precision a(n,n),at(n,n)
7349 C---------------------------------------------------------------------------
7350 subroutine prodmat3(a1,a2,kk,transp,prod)
7353 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7355 crc double precision auxmat(2,2),prod_(2,2)
7358 crc call transpose2(kk(1,1),auxmat(1,1))
7359 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7360 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7362 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7363 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7364 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7365 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7366 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7367 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7368 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7369 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7372 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7373 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7375 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7376 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7377 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7378 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7379 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7380 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7381 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7382 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7385 c call transpose2(a2(1,1),a2t(1,1))
7388 crc print *,((prod_(i,j),i=1,2),j=1,2)
7389 crc print *,((prod(i,j),i=1,2),j=1,2)
7393 C-----------------------------------------------------------------------------
7394 double precision function scalar(u,v)
7396 double precision u(3),v(3)