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+nss*ebr+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+nss*ebr+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
158 idumm=proc_proc(etot,i)
160 call proc_proc(etot,i)
162 if(i.eq.1)energia(0)=1.0d+99
168 C Sum up the components of the Cartesian gradient.
173 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
174 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
176 & wstrain*ghpbc(j,i)+
177 & wcorr*fact(3)*gradcorr(j,i)+
178 & wel_loc*fact(2)*gel_loc(j,i)+
179 & wturn3*fact(2)*gcorr3_turn(j,i)+
180 & wturn4*fact(3)*gcorr4_turn(j,i)+
181 & wcorr5*fact(4)*gradcorr5(j,i)+
182 & wcorr6*fact(5)*gradcorr6(j,i)+
183 & wturn6*fact(5)*gcorr6_turn(j,i)+
184 & wsccor*fact(2)*gsccorc(j,i)
185 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
187 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
192 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
193 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
195 & wcorr*fact(3)*gradcorr(j,i)+
196 & wel_loc*fact(2)*gel_loc(j,i)+
197 & wturn3*fact(2)*gcorr3_turn(j,i)+
198 & wturn4*fact(3)*gcorr4_turn(j,i)+
199 & wcorr5*fact(4)*gradcorr5(j,i)+
200 & wcorr6*fact(5)*gradcorr6(j,i)+
201 & wturn6*fact(5)*gcorr6_turn(j,i)+
202 & wsccor*fact(2)*gsccorc(j,i)
203 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
205 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
208 cd print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3),
209 cd & (gradc(k,i),k=1,3)
214 cd write (iout,*) i,g_corr5_loc(i)
215 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
216 & +wcorr5*fact(4)*g_corr5_loc(i)
217 & +wcorr6*fact(5)*g_corr6_loc(i)
218 & +wturn4*fact(3)*gel_loc_turn4(i)
219 & +wturn3*fact(2)*gel_loc_turn3(i)
220 & +wturn6*fact(5)*gel_loc_turn6(i)
221 & +wel_loc*fact(2)*gel_loc_loc(i)+
222 & +wsccor*fact(1)*gsccor_loc(i)
225 cd call enerprint(energia(0),fact)
230 C------------------------------------------------------------------------
231 subroutine enerprint(energia,fact)
232 implicit real*8 (a-h,o-z)
234 include 'sizesclu.dat'
235 include 'COMMON.IOUNITS'
236 include 'COMMON.FFIELD'
237 include 'COMMON.SBRIDGE'
238 double precision energia(0:max_ene),fact(5)
242 evdw2=energia(2)+energia(17)
254 eello_turn3=energia(8)
255 eello_turn4=energia(9)
256 eello_turn6=energia(10)
263 edihcnstr=energia(20)
266 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
268 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
269 & etors_d,wtor_d*fact(2),ehpb,wstrain,
270 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
271 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
272 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
273 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
274 10 format (/'Virtual-chain energies:'//
275 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
276 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
277 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
278 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
279 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
280 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
281 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
282 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
283 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
284 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
285 & ' (SS bridges & dist. cnstr.)'/
286 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
287 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
288 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
289 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
290 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
291 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
292 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
293 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
294 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
295 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
296 & 'ETOT= ',1pE16.6,' (total)')
298 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
299 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
300 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
301 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
302 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
303 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
304 & edihcnstr,ebr*nss,etot
305 10 format (/'Virtual-chain energies:'//
306 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
307 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
308 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
309 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
310 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
311 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
312 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
313 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
314 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
315 & ' (SS bridges & dist. cnstr.)'/
316 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
317 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
318 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
319 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
320 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
321 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
322 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
323 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
324 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
325 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
326 & 'ETOT= ',1pE16.6,' (total)')
330 C-----------------------------------------------------------------------
333 C This subroutine calculates the interaction energy of nonbonded side chains
334 C assuming the LJ potential of interaction.
336 implicit real*8 (a-h,o-z)
338 include 'sizesclu.dat'
339 include "DIMENSIONS.COMPAR"
340 parameter (accur=1.0d-10)
343 include 'COMMON.LOCAL'
344 include 'COMMON.CHAIN'
345 include 'COMMON.DERIV'
346 include 'COMMON.INTERACT'
347 include 'COMMON.TORSION'
348 include 'COMMON.SBRIDGE'
349 include 'COMMON.NAMES'
350 include 'COMMON.IOUNITS'
351 include 'COMMON.CONTACTS'
355 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
366 C Calculate SC interaction energy.
369 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
370 cd & 'iend=',iend(i,iint)
371 do j=istart(i,iint),iend(i,iint)
376 C Change 12/1/95 to calculate four-body interactions
377 rij=xj*xj+yj*yj+zj*zj
379 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
380 eps0ij=eps(itypi,itypj)
382 e1=fac*fac*aa(itypi,itypj)
383 e2=fac*bb(itypi,itypj)
385 ij=icant(itypi,itypj)
386 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
387 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
388 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
389 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
390 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
391 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
395 C Calculate the components of the gradient in DC and X
397 fac=-rrij*(e1+evdwij)
402 gvdwx(k,i)=gvdwx(k,i)-gg(k)
403 gvdwx(k,j)=gvdwx(k,j)+gg(k)
407 gvdwc(l,k)=gvdwc(l,k)+gg(l)
412 C 12/1/95, revised on 5/20/97
414 C Calculate the contact function. The ith column of the array JCONT will
415 C contain the numbers of atoms that make contacts with the atom I (of numbers
416 C greater than I). The arrays FACONT and GACONT will contain the values of
417 C the contact function and its derivative.
419 C Uncomment next line, if the correlation interactions include EVDW explicitly.
420 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
421 C Uncomment next line, if the correlation interactions are contact function only
422 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
424 sigij=sigma(itypi,itypj)
425 r0ij=rs0(itypi,itypj)
427 C Check whether the SC's are not too far to make a contact.
430 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
431 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
433 if (fcont.gt.0.0D0) then
434 C If the SC-SC distance if close to sigma, apply spline.
435 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
436 cAdam & fcont1,fprimcont1)
437 cAdam fcont1=1.0d0-fcont1
438 cAdam if (fcont1.gt.0.0d0) then
439 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
440 cAdam fcont=fcont*fcont1
442 C Uncomment following 4 lines to have the geometric average of the epsilon0's
443 cga eps0ij=1.0d0/dsqrt(eps0ij)
445 cga gg(k)=gg(k)*eps0ij
447 cga eps0ij=-evdwij*eps0ij
448 C Uncomment for AL's type of SC correlation interactions.
450 num_conti=num_conti+1
452 facont(num_conti,i)=fcont*eps0ij
453 fprimcont=eps0ij*fprimcont/rij
455 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
456 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
457 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
458 C Uncomment following 3 lines for Skolnick's type of SC correlation.
459 gacont(1,num_conti,i)=-fprimcont*xj
460 gacont(2,num_conti,i)=-fprimcont*yj
461 gacont(3,num_conti,i)=-fprimcont*zj
462 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
463 cd write (iout,'(2i3,3f10.5)')
464 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
470 num_cont(i)=num_conti
475 gvdwc(j,i)=expon*gvdwc(j,i)
476 gvdwx(j,i)=expon*gvdwx(j,i)
480 C******************************************************************************
484 C To save time, the factor of EXPON has been extracted from ALL components
485 C of GVDWC and GRADX. Remember to multiply them by this factor before further
488 C******************************************************************************
491 C-----------------------------------------------------------------------------
492 subroutine eljk(evdw)
494 C This subroutine calculates the interaction energy of nonbonded side chains
495 C assuming the LJK potential of interaction.
497 implicit real*8 (a-h,o-z)
499 include 'sizesclu.dat'
500 include "DIMENSIONS.COMPAR"
503 include 'COMMON.LOCAL'
504 include 'COMMON.CHAIN'
505 include 'COMMON.DERIV'
506 include 'COMMON.INTERACT'
507 include 'COMMON.IOUNITS'
508 include 'COMMON.NAMES'
513 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
522 C Calculate SC interaction energy.
525 do j=istart(i,iint),iend(i,iint)
530 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
532 e_augm=augm(itypi,itypj)*fac_augm
535 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
536 fac=r_shift_inv**expon
537 e1=fac*fac*aa(itypi,itypj)
538 e2=fac*bb(itypi,itypj)
540 ij=icant(itypi,itypj)
541 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
542 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
543 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
544 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
545 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
546 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
547 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
551 C Calculate the components of the gradient in DC and X
553 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
558 gvdwx(k,i)=gvdwx(k,i)-gg(k)
559 gvdwx(k,j)=gvdwx(k,j)+gg(k)
563 gvdwc(l,k)=gvdwc(l,k)+gg(l)
573 gvdwc(j,i)=expon*gvdwc(j,i)
574 gvdwx(j,i)=expon*gvdwx(j,i)
580 C-----------------------------------------------------------------------------
583 C This subroutine calculates the interaction energy of nonbonded side chains
584 C assuming the Berne-Pechukas potential of interaction.
586 implicit real*8 (a-h,o-z)
588 include 'sizesclu.dat'
589 include "DIMENSIONS.COMPAR"
592 include 'COMMON.LOCAL'
593 include 'COMMON.CHAIN'
594 include 'COMMON.DERIV'
595 include 'COMMON.NAMES'
596 include 'COMMON.INTERACT'
597 include 'COMMON.IOUNITS'
598 include 'COMMON.CALC'
600 c double precision rrsave(maxdim)
605 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
607 c if (icall.eq.0) then
619 dxi=dc_norm(1,nres+i)
620 dyi=dc_norm(2,nres+i)
621 dzi=dc_norm(3,nres+i)
622 dsci_inv=vbld_inv(i+nres)
624 C Calculate SC interaction energy.
627 do j=istart(i,iint),iend(i,iint)
630 dscj_inv=vbld_inv(j+nres)
631 chi1=chi(itypi,itypj)
632 chi2=chi(itypj,itypi)
639 alf12=0.5D0*(alf1+alf2)
640 C For diagnostics only!!!
653 dxj=dc_norm(1,nres+j)
654 dyj=dc_norm(2,nres+j)
655 dzj=dc_norm(3,nres+j)
656 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
657 cd if (icall.eq.0) then
663 C Calculate the angle-dependent terms of energy & contributions to derivatives.
665 C Calculate whole angle-dependent part of epsilon and contributions
667 fac=(rrij*sigsq)**expon2
668 e1=fac*fac*aa(itypi,itypj)
669 e2=fac*bb(itypi,itypj)
670 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
671 eps2der=evdwij*eps3rt
672 eps3der=evdwij*eps2rt
673 evdwij=evdwij*eps2rt*eps3rt
674 ij=icant(itypi,itypj)
675 aux=eps1*eps2rt**2*eps3rt**2
679 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
680 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
681 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
682 cd & restyp(itypi),i,restyp(itypj),j,
683 cd & epsi,sigm,chi1,chi2,chip1,chip2,
684 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
685 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
688 C Calculate gradient components.
689 e1=e1*eps1*eps2rt**2*eps3rt**2
690 fac=-expon*(e1+evdwij)
693 C Calculate radial part of the gradient
697 C Calculate the angular part of the gradient and sum add the contributions
698 C to the appropriate components of the Cartesian gradient.
707 C-----------------------------------------------------------------------------
710 C This subroutine calculates the interaction energy of nonbonded side chains
711 C assuming the Gay-Berne potential of interaction.
713 implicit real*8 (a-h,o-z)
715 include 'sizesclu.dat'
716 include "DIMENSIONS.COMPAR"
719 include 'COMMON.LOCAL'
720 include 'COMMON.CHAIN'
721 include 'COMMON.DERIV'
722 include 'COMMON.NAMES'
723 include 'COMMON.INTERACT'
724 include 'COMMON.IOUNITS'
725 include 'COMMON.CALC'
731 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
734 c if (icall.gt.0) lprn=.true.
742 dxi=dc_norm(1,nres+i)
743 dyi=dc_norm(2,nres+i)
744 dzi=dc_norm(3,nres+i)
745 dsci_inv=vbld_inv(i+nres)
747 C Calculate SC interaction energy.
750 do j=istart(i,iint),iend(i,iint)
753 dscj_inv=vbld_inv(j+nres)
754 sig0ij=sigma(itypi,itypj)
755 chi1=chi(itypi,itypj)
756 chi2=chi(itypj,itypi)
763 alf12=0.5D0*(alf1+alf2)
764 C For diagnostics only!!!
777 dxj=dc_norm(1,nres+j)
778 dyj=dc_norm(2,nres+j)
779 dzj=dc_norm(3,nres+j)
780 c write (iout,*) i,j,xj,yj,zj
781 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
783 C Calculate angle-dependent terms of energy and contributions to their
787 sig=sig0ij*dsqrt(sigsq)
788 rij_shift=1.0D0/rij-sig+sig0ij
789 C I hate to put IF's in the loops, but here don't have another choice!!!!
790 if (rij_shift.le.0.0D0) then
795 c---------------------------------------------------------------
796 rij_shift=1.0D0/rij_shift
798 e1=fac*fac*aa(itypi,itypj)
799 e2=fac*bb(itypi,itypj)
800 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
801 eps2der=evdwij*eps3rt
802 eps3der=evdwij*eps2rt
803 evdwij=evdwij*eps2rt*eps3rt
805 ij=icant(itypi,itypj)
806 aux=eps1*eps2rt**2*eps3rt**2
807 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
808 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
809 c & aux*e2/eps(itypi,itypj)
811 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
812 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
813 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
814 & restyp(itypi),i,restyp(itypj),j,
815 & epsi,sigm,chi1,chi2,chip1,chip2,
816 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
817 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
821 C Calculate gradient components.
822 e1=e1*eps1*eps2rt**2*eps3rt**2
823 fac=-expon*(e1+evdwij)*rij_shift
826 C Calculate the radial part of the gradient
830 C Calculate angular part of the gradient.
838 C-----------------------------------------------------------------------------
839 subroutine egbv(evdw)
841 C This subroutine calculates the interaction energy of nonbonded side chains
842 C assuming the Gay-Berne-Vorobjev potential of interaction.
844 implicit real*8 (a-h,o-z)
846 include 'sizesclu.dat'
847 include "DIMENSIONS.COMPAR"
850 include 'COMMON.LOCAL'
851 include 'COMMON.CHAIN'
852 include 'COMMON.DERIV'
853 include 'COMMON.NAMES'
854 include 'COMMON.INTERACT'
855 include 'COMMON.IOUNITS'
856 include 'COMMON.CALC'
862 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
865 c if (icall.gt.0) lprn=.true.
873 dxi=dc_norm(1,nres+i)
874 dyi=dc_norm(2,nres+i)
875 dzi=dc_norm(3,nres+i)
876 dsci_inv=vbld_inv(i+nres)
878 C Calculate SC interaction energy.
881 do j=istart(i,iint),iend(i,iint)
884 dscj_inv=vbld_inv(j+nres)
885 sig0ij=sigma(itypi,itypj)
887 chi1=chi(itypi,itypj)
888 chi2=chi(itypj,itypi)
895 alf12=0.5D0*(alf1+alf2)
896 C For diagnostics only!!!
909 dxj=dc_norm(1,nres+j)
910 dyj=dc_norm(2,nres+j)
911 dzj=dc_norm(3,nres+j)
912 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
914 C Calculate angle-dependent terms of energy and contributions to their
918 sig=sig0ij*dsqrt(sigsq)
919 rij_shift=1.0D0/rij-sig+r0ij
920 C I hate to put IF's in the loops, but here don't have another choice!!!!
921 if (rij_shift.le.0.0D0) then
926 c---------------------------------------------------------------
927 rij_shift=1.0D0/rij_shift
929 e1=fac*fac*aa(itypi,itypj)
930 e2=fac*bb(itypi,itypj)
931 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
932 eps2der=evdwij*eps3rt
933 eps3der=evdwij*eps2rt
935 e_augm=augm(itypi,itypj)*fac_augm
936 evdwij=evdwij*eps2rt*eps3rt
937 evdw=evdw+evdwij+e_augm
938 ij=icant(itypi,itypj)
939 aux=eps1*eps2rt**2*eps3rt**2
941 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
942 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
943 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
944 c & restyp(itypi),i,restyp(itypj),j,
945 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
946 c & chi1,chi2,chip1,chip2,
947 c & eps1,eps2rt**2,eps3rt**2,
948 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
952 C Calculate gradient components.
953 e1=e1*eps1*eps2rt**2*eps3rt**2
954 fac=-expon*(e1+evdwij)*rij_shift
956 fac=rij*fac-2*expon*rrij*e_augm
957 C Calculate the radial part of the gradient
961 C Calculate angular part of the gradient.
969 C-----------------------------------------------------------------------------
970 subroutine sc_angular
971 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
972 C om12. Called by ebp, egb, and egbv.
974 include 'COMMON.CALC'
978 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
979 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
980 om12=dxi*dxj+dyi*dyj+dzi*dzj
982 C Calculate eps1(om12) and its derivative in om12
983 faceps1=1.0D0-om12*chiom12
984 faceps1_inv=1.0D0/faceps1
985 eps1=dsqrt(faceps1_inv)
986 C Following variable is eps1*deps1/dom12
987 eps1_om12=faceps1_inv*chiom12
988 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
993 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
994 sigsq=1.0D0-facsig*faceps1_inv
995 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
996 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
997 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
998 C Calculate eps2 and its derivatives in om1, om2, and om12.
1001 chipom12=chip12*om12
1002 facp=1.0D0-om12*chipom12
1004 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1005 C Following variable is the square root of eps2
1006 eps2rt=1.0D0-facp1*facp_inv
1007 C Following three variables are the derivatives of the square root of eps
1008 C in om1, om2, and om12.
1009 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1010 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1011 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1012 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1013 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1014 C Calculate whole angle-dependent part of epsilon and contributions
1015 C to its derivatives
1018 C----------------------------------------------------------------------------
1020 implicit real*8 (a-h,o-z)
1021 include 'DIMENSIONS'
1022 include 'sizesclu.dat'
1023 include 'COMMON.CHAIN'
1024 include 'COMMON.DERIV'
1025 include 'COMMON.CALC'
1026 double precision dcosom1(3),dcosom2(3)
1027 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1028 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1029 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1030 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1032 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1033 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1036 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1039 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1040 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1041 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1042 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1043 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1044 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1047 C Calculate the components of the gradient in DC and X
1051 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1056 c------------------------------------------------------------------------------
1057 subroutine vec_and_deriv
1058 implicit real*8 (a-h,o-z)
1059 include 'DIMENSIONS'
1060 include 'sizesclu.dat'
1061 include 'COMMON.IOUNITS'
1062 include 'COMMON.GEO'
1063 include 'COMMON.VAR'
1064 include 'COMMON.LOCAL'
1065 include 'COMMON.CHAIN'
1066 include 'COMMON.VECTORS'
1067 include 'COMMON.DERIV'
1068 include 'COMMON.INTERACT'
1069 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1070 C Compute the local reference systems. For reference system (i), the
1071 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1072 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1074 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1075 if (i.eq.nres-1) then
1076 C Case of the last full residue
1077 C Compute the Z-axis
1078 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1079 costh=dcos(pi-theta(nres))
1080 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1085 C Compute the derivatives of uz
1087 uzder(2,1,1)=-dc_norm(3,i-1)
1088 uzder(3,1,1)= dc_norm(2,i-1)
1089 uzder(1,2,1)= dc_norm(3,i-1)
1091 uzder(3,2,1)=-dc_norm(1,i-1)
1092 uzder(1,3,1)=-dc_norm(2,i-1)
1093 uzder(2,3,1)= dc_norm(1,i-1)
1096 uzder(2,1,2)= dc_norm(3,i)
1097 uzder(3,1,2)=-dc_norm(2,i)
1098 uzder(1,2,2)=-dc_norm(3,i)
1100 uzder(3,2,2)= dc_norm(1,i)
1101 uzder(1,3,2)= dc_norm(2,i)
1102 uzder(2,3,2)=-dc_norm(1,i)
1105 C Compute the Y-axis
1108 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1111 C Compute the derivatives of uy
1114 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1115 & -dc_norm(k,i)*dc_norm(j,i-1)
1116 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1118 uyder(j,j,1)=uyder(j,j,1)-costh
1119 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1124 uygrad(l,k,j,i)=uyder(l,k,j)
1125 uzgrad(l,k,j,i)=uzder(l,k,j)
1129 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1130 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1131 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1132 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1136 C Compute the Z-axis
1137 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1138 costh=dcos(pi-theta(i+2))
1139 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1144 C Compute the derivatives of uz
1146 uzder(2,1,1)=-dc_norm(3,i+1)
1147 uzder(3,1,1)= dc_norm(2,i+1)
1148 uzder(1,2,1)= dc_norm(3,i+1)
1150 uzder(3,2,1)=-dc_norm(1,i+1)
1151 uzder(1,3,1)=-dc_norm(2,i+1)
1152 uzder(2,3,1)= dc_norm(1,i+1)
1155 uzder(2,1,2)= dc_norm(3,i)
1156 uzder(3,1,2)=-dc_norm(2,i)
1157 uzder(1,2,2)=-dc_norm(3,i)
1159 uzder(3,2,2)= dc_norm(1,i)
1160 uzder(1,3,2)= dc_norm(2,i)
1161 uzder(2,3,2)=-dc_norm(1,i)
1164 C Compute the Y-axis
1167 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1170 C Compute the derivatives of uy
1173 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1174 & -dc_norm(k,i)*dc_norm(j,i+1)
1175 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1177 uyder(j,j,1)=uyder(j,j,1)-costh
1178 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1183 uygrad(l,k,j,i)=uyder(l,k,j)
1184 uzgrad(l,k,j,i)=uzder(l,k,j)
1188 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1189 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1190 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1191 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1197 vbld_inv_temp(1)=vbld_inv(i+1)
1198 if (i.lt.nres-1) then
1199 vbld_inv_temp(2)=vbld_inv(i+2)
1201 vbld_inv_temp(2)=vbld_inv(i)
1206 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1207 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1215 C-----------------------------------------------------------------------------
1216 subroutine vec_and_deriv_test
1217 implicit real*8 (a-h,o-z)
1218 include 'DIMENSIONS'
1219 include 'sizesclu.dat'
1220 include 'COMMON.IOUNITS'
1221 include 'COMMON.GEO'
1222 include 'COMMON.VAR'
1223 include 'COMMON.LOCAL'
1224 include 'COMMON.CHAIN'
1225 include 'COMMON.VECTORS'
1226 dimension uyder(3,3,2),uzder(3,3,2)
1227 C Compute the local reference systems. For reference system (i), the
1228 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1229 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1231 if (i.eq.nres-1) then
1232 C Case of the last full residue
1233 C Compute the Z-axis
1234 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1235 costh=dcos(pi-theta(nres))
1236 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1237 c write (iout,*) 'fac',fac,
1238 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1239 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1243 C Compute the derivatives of uz
1245 uzder(2,1,1)=-dc_norm(3,i-1)
1246 uzder(3,1,1)= dc_norm(2,i-1)
1247 uzder(1,2,1)= dc_norm(3,i-1)
1249 uzder(3,2,1)=-dc_norm(1,i-1)
1250 uzder(1,3,1)=-dc_norm(2,i-1)
1251 uzder(2,3,1)= dc_norm(1,i-1)
1254 uzder(2,1,2)= dc_norm(3,i)
1255 uzder(3,1,2)=-dc_norm(2,i)
1256 uzder(1,2,2)=-dc_norm(3,i)
1258 uzder(3,2,2)= dc_norm(1,i)
1259 uzder(1,3,2)= dc_norm(2,i)
1260 uzder(2,3,2)=-dc_norm(1,i)
1262 C Compute the Y-axis
1264 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1267 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1268 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1269 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1271 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1274 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1275 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1278 c write (iout,*) 'facy',facy,
1279 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1280 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1282 uy(k,i)=facy*uy(k,i)
1284 C Compute the derivatives of uy
1287 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1288 & -dc_norm(k,i)*dc_norm(j,i-1)
1289 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1291 c uyder(j,j,1)=uyder(j,j,1)-costh
1292 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1293 uyder(j,j,1)=uyder(j,j,1)
1294 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1295 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1301 uygrad(l,k,j,i)=uyder(l,k,j)
1302 uzgrad(l,k,j,i)=uzder(l,k,j)
1306 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1307 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1308 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1309 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1312 C Compute the Z-axis
1313 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1314 costh=dcos(pi-theta(i+2))
1315 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1316 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1320 C Compute the derivatives of uz
1322 uzder(2,1,1)=-dc_norm(3,i+1)
1323 uzder(3,1,1)= dc_norm(2,i+1)
1324 uzder(1,2,1)= dc_norm(3,i+1)
1326 uzder(3,2,1)=-dc_norm(1,i+1)
1327 uzder(1,3,1)=-dc_norm(2,i+1)
1328 uzder(2,3,1)= dc_norm(1,i+1)
1331 uzder(2,1,2)= dc_norm(3,i)
1332 uzder(3,1,2)=-dc_norm(2,i)
1333 uzder(1,2,2)=-dc_norm(3,i)
1335 uzder(3,2,2)= dc_norm(1,i)
1336 uzder(1,3,2)= dc_norm(2,i)
1337 uzder(2,3,2)=-dc_norm(1,i)
1339 C Compute the Y-axis
1341 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1342 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1343 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1345 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1348 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1349 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1352 c write (iout,*) 'facy',facy,
1353 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1354 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1356 uy(k,i)=facy*uy(k,i)
1358 C Compute the derivatives of uy
1361 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1362 & -dc_norm(k,i)*dc_norm(j,i+1)
1363 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1365 c uyder(j,j,1)=uyder(j,j,1)-costh
1366 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1367 uyder(j,j,1)=uyder(j,j,1)
1368 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1369 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1375 uygrad(l,k,j,i)=uyder(l,k,j)
1376 uzgrad(l,k,j,i)=uzder(l,k,j)
1380 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1381 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1382 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1383 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1390 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1391 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1398 C-----------------------------------------------------------------------------
1399 subroutine check_vecgrad
1400 implicit real*8 (a-h,o-z)
1401 include 'DIMENSIONS'
1402 include 'sizesclu.dat'
1403 include 'COMMON.IOUNITS'
1404 include 'COMMON.GEO'
1405 include 'COMMON.VAR'
1406 include 'COMMON.LOCAL'
1407 include 'COMMON.CHAIN'
1408 include 'COMMON.VECTORS'
1409 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1410 dimension uyt(3,maxres),uzt(3,maxres)
1411 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1412 double precision delta /1.0d-7/
1415 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1416 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1417 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1418 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1419 cd & (dc_norm(if90,i),if90=1,3)
1420 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1421 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1422 cd write(iout,'(a)')
1428 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1429 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1442 cd write (iout,*) 'i=',i
1444 erij(k)=dc_norm(k,i)
1448 dc_norm(k,i)=erij(k)
1450 dc_norm(j,i)=dc_norm(j,i)+delta
1451 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1453 c dc_norm(k,i)=dc_norm(k,i)/fac
1455 c write (iout,*) (dc_norm(k,i),k=1,3)
1456 c write (iout,*) (erij(k),k=1,3)
1459 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1460 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1461 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1462 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1464 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1465 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1466 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1469 dc_norm(k,i)=erij(k)
1472 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1473 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1474 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1475 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1476 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1477 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1478 cd write (iout,'(a)')
1483 C--------------------------------------------------------------------------
1484 subroutine set_matrices
1485 implicit real*8 (a-h,o-z)
1486 include 'DIMENSIONS'
1487 include 'sizesclu.dat'
1488 include 'COMMON.IOUNITS'
1489 include 'COMMON.GEO'
1490 include 'COMMON.VAR'
1491 include 'COMMON.LOCAL'
1492 include 'COMMON.CHAIN'
1493 include 'COMMON.DERIV'
1494 include 'COMMON.INTERACT'
1495 include 'COMMON.CONTACTS'
1496 include 'COMMON.TORSION'
1497 include 'COMMON.VECTORS'
1498 include 'COMMON.FFIELD'
1499 double precision auxvec(2),auxmat(2,2)
1501 C Compute the virtual-bond-torsional-angle dependent quantities needed
1502 C to calculate the el-loc multibody terms of various order.
1505 if (i .lt. nres+1) then
1542 if (i .gt. 3 .and. i .lt. nres+1) then
1543 obrot_der(1,i-2)=-sin1
1544 obrot_der(2,i-2)= cos1
1545 Ugder(1,1,i-2)= sin1
1546 Ugder(1,2,i-2)=-cos1
1547 Ugder(2,1,i-2)=-cos1
1548 Ugder(2,2,i-2)=-sin1
1551 obrot2_der(1,i-2)=-dwasin2
1552 obrot2_der(2,i-2)= dwacos2
1553 Ug2der(1,1,i-2)= dwasin2
1554 Ug2der(1,2,i-2)=-dwacos2
1555 Ug2der(2,1,i-2)=-dwacos2
1556 Ug2der(2,2,i-2)=-dwasin2
1558 obrot_der(1,i-2)=0.0d0
1559 obrot_der(2,i-2)=0.0d0
1560 Ugder(1,1,i-2)=0.0d0
1561 Ugder(1,2,i-2)=0.0d0
1562 Ugder(2,1,i-2)=0.0d0
1563 Ugder(2,2,i-2)=0.0d0
1564 obrot2_der(1,i-2)=0.0d0
1565 obrot2_der(2,i-2)=0.0d0
1566 Ug2der(1,1,i-2)=0.0d0
1567 Ug2der(1,2,i-2)=0.0d0
1568 Ug2der(2,1,i-2)=0.0d0
1569 Ug2der(2,2,i-2)=0.0d0
1571 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1572 iti = itortyp(itype(i-2))
1576 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1577 iti1 = itortyp(itype(i-1))
1581 cd write (iout,*) '*******i',i,' iti1',iti
1582 cd write (iout,*) 'b1',b1(:,iti)
1583 cd write (iout,*) 'b2',b2(:,iti)
1584 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1585 if (i .gt. iatel_s+2) then
1586 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1587 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1588 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1589 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1590 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1591 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1592 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1602 DtUg2(l,k,i-2)=0.0d0
1606 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1607 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1608 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1609 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1610 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1611 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1612 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1614 muder(k,i-2)=Ub2der(k,i-2)
1616 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1617 iti1 = itortyp(itype(i-1))
1622 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1624 C Vectors and matrices dependent on a single virtual-bond dihedral.
1625 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1626 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1627 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1628 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1629 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1630 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1631 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1632 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1633 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1634 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1635 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1637 C Matrices dependent on two consecutive virtual-bond dihedrals.
1638 C The order of matrices is from left to right.
1640 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1641 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1642 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1643 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1644 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1645 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1646 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1647 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1650 cd iti = itortyp(itype(i))
1653 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1654 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1659 C--------------------------------------------------------------------------
1660 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1662 C This subroutine calculates the average interaction energy and its gradient
1663 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1664 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1665 C The potential depends both on the distance of peptide-group centers and on
1666 C the orientation of the CA-CA virtual bonds.
1668 implicit real*8 (a-h,o-z)
1669 include 'DIMENSIONS'
1670 include 'sizesclu.dat'
1671 include 'COMMON.CONTROL'
1672 include 'COMMON.IOUNITS'
1673 include 'COMMON.GEO'
1674 include 'COMMON.VAR'
1675 include 'COMMON.LOCAL'
1676 include 'COMMON.CHAIN'
1677 include 'COMMON.DERIV'
1678 include 'COMMON.INTERACT'
1679 include 'COMMON.CONTACTS'
1680 include 'COMMON.TORSION'
1681 include 'COMMON.VECTORS'
1682 include 'COMMON.FFIELD'
1683 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1684 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1685 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1686 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1687 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1688 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1689 double precision scal_el /0.5d0/
1691 C 13-go grudnia roku pamietnego...
1692 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1693 & 0.0d0,1.0d0,0.0d0,
1694 & 0.0d0,0.0d0,1.0d0/
1695 cd write(iout,*) 'In EELEC'
1697 cd write(iout,*) 'Type',i
1698 cd write(iout,*) 'B1',B1(:,i)
1699 cd write(iout,*) 'B2',B2(:,i)
1700 cd write(iout,*) 'CC',CC(:,:,i)
1701 cd write(iout,*) 'DD',DD(:,:,i)
1702 cd write(iout,*) 'EE',EE(:,:,i)
1704 cd call check_vecgrad
1706 if (icheckgrad.eq.1) then
1708 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1710 dc_norm(k,i)=dc(k,i)*fac
1712 c write (iout,*) 'i',i,' fac',fac
1715 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1716 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1717 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1718 cd if (wel_loc.gt.0.0d0) then
1719 if (icheckgrad.eq.1) then
1720 call vec_and_deriv_test
1727 cd write (iout,*) 'i=',i
1729 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1732 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1733 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1746 cd print '(a)','Enter EELEC'
1747 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1749 gel_loc_loc(i)=0.0d0
1752 do i=iatel_s,iatel_e
1753 if (itel(i).eq.0) goto 1215
1757 dx_normi=dc_norm(1,i)
1758 dy_normi=dc_norm(2,i)
1759 dz_normi=dc_norm(3,i)
1760 xmedi=c(1,i)+0.5d0*dxi
1761 ymedi=c(2,i)+0.5d0*dyi
1762 zmedi=c(3,i)+0.5d0*dzi
1764 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1765 do j=ielstart(i),ielend(i)
1766 if (itel(j).eq.0) goto 1216
1770 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1771 aaa=app(iteli,itelj)
1772 bbb=bpp(iteli,itelj)
1773 C Diagnostics only!!!
1779 ael6i=ael6(iteli,itelj)
1780 ael3i=ael3(iteli,itelj)
1784 dx_normj=dc_norm(1,j)
1785 dy_normj=dc_norm(2,j)
1786 dz_normj=dc_norm(3,j)
1787 xj=c(1,j)+0.5D0*dxj-xmedi
1788 yj=c(2,j)+0.5D0*dyj-ymedi
1789 zj=c(3,j)+0.5D0*dzj-zmedi
1790 rij=xj*xj+yj*yj+zj*zj
1796 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1797 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1798 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1799 fac=cosa-3.0D0*cosb*cosg
1801 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1802 if (j.eq.i+2) ev1=scal_el*ev1
1807 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1810 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1811 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1812 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1815 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1816 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1817 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1818 cd & xmedi,ymedi,zmedi,xj,yj,zj
1820 C Calculate contributions to the Cartesian gradient.
1823 facvdw=-6*rrmij*(ev1+evdwij)
1824 facel=-3*rrmij*(el1+eesij)
1831 * Radial derivatives. First process both termini of the fragment (i,j)
1838 gelc(k,i)=gelc(k,i)+ghalf
1839 gelc(k,j)=gelc(k,j)+ghalf
1842 * Loop over residues i+1 thru j-1.
1846 gelc(l,k)=gelc(l,k)+ggg(l)
1854 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1855 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1858 * Loop over residues i+1 thru j-1.
1862 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1869 fac=-3*rrmij*(facvdw+facvdw+facel)
1875 * Radial derivatives. First process both termini of the fragment (i,j)
1882 gelc(k,i)=gelc(k,i)+ghalf
1883 gelc(k,j)=gelc(k,j)+ghalf
1886 * Loop over residues i+1 thru j-1.
1890 gelc(l,k)=gelc(l,k)+ggg(l)
1897 ecosa=2.0D0*fac3*fac1+fac4
1900 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1901 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1903 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1904 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1906 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1907 cd & (dcosg(k),k=1,3)
1909 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1913 gelc(k,i)=gelc(k,i)+ghalf
1914 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1915 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1916 gelc(k,j)=gelc(k,j)+ghalf
1917 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1918 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1922 gelc(l,k)=gelc(l,k)+ggg(l)
1927 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1928 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
1929 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
1931 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
1932 C energy of a peptide unit is assumed in the form of a second-order
1933 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
1934 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
1935 C are computed for EVERY pair of non-contiguous peptide groups.
1937 if (j.lt.nres-1) then
1948 muij(kkk)=mu(k,i)*mu(l,j)
1951 cd write (iout,*) 'EELEC: i',i,' j',j
1952 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
1953 cd write(iout,*) 'muij',muij
1954 ury=scalar(uy(1,i),erij)
1955 urz=scalar(uz(1,i),erij)
1956 vry=scalar(uy(1,j),erij)
1957 vrz=scalar(uz(1,j),erij)
1958 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
1959 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
1960 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
1961 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
1962 C For diagnostics only
1967 fac=dsqrt(-ael6i)*r3ij
1968 cd write (2,*) 'fac=',fac
1969 C For diagnostics only
1975 cd write (iout,'(4i5,4f10.5)')
1976 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
1977 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
1978 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
1979 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
1980 cd write (iout,'(4f10.5)')
1981 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
1982 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
1983 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
1984 cd write (iout,'(2i3,9f10.5/)') i,j,
1985 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
1987 C Derivatives of the elements of A in virtual-bond vectors
1988 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
1995 uryg(k,1)=scalar(erder(1,k),uy(1,i))
1996 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
1997 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
1998 urzg(k,1)=scalar(erder(1,k),uz(1,i))
1999 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2000 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2001 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2002 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2003 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2004 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2005 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2006 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2016 C Compute radial contributions to the gradient
2038 C Add the contributions coming from er
2041 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2042 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2043 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2044 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2047 C Derivatives in DC(i)
2048 ghalf1=0.5d0*agg(k,1)
2049 ghalf2=0.5d0*agg(k,2)
2050 ghalf3=0.5d0*agg(k,3)
2051 ghalf4=0.5d0*agg(k,4)
2052 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2053 & -3.0d0*uryg(k,2)*vry)+ghalf1
2054 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2055 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2056 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2057 & -3.0d0*urzg(k,2)*vry)+ghalf3
2058 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2059 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2060 C Derivatives in DC(i+1)
2061 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2062 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2063 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2064 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2065 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2066 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2067 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2068 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2069 C Derivatives in DC(j)
2070 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2071 & -3.0d0*vryg(k,2)*ury)+ghalf1
2072 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2073 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2074 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2075 & -3.0d0*vryg(k,2)*urz)+ghalf3
2076 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2077 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2078 C Derivatives in DC(j+1) or DC(nres-1)
2079 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2080 & -3.0d0*vryg(k,3)*ury)
2081 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2082 & -3.0d0*vrzg(k,3)*ury)
2083 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2084 & -3.0d0*vryg(k,3)*urz)
2085 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2086 & -3.0d0*vrzg(k,3)*urz)
2091 C Derivatives in DC(i+1)
2092 cd aggi1(k,1)=agg(k,1)
2093 cd aggi1(k,2)=agg(k,2)
2094 cd aggi1(k,3)=agg(k,3)
2095 cd aggi1(k,4)=agg(k,4)
2096 C Derivatives in DC(j)
2101 C Derivatives in DC(j+1)
2106 if (j.eq.nres-1 .and. i.lt.j-2) then
2108 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2109 cd aggj1(k,l)=agg(k,l)
2115 C Check the loc-el terms by numerical integration
2125 aggi(k,l)=-aggi(k,l)
2126 aggi1(k,l)=-aggi1(k,l)
2127 aggj(k,l)=-aggj(k,l)
2128 aggj1(k,l)=-aggj1(k,l)
2131 if (j.lt.nres-1) then
2137 aggi(k,l)=-aggi(k,l)
2138 aggi1(k,l)=-aggi1(k,l)
2139 aggj(k,l)=-aggj(k,l)
2140 aggj1(k,l)=-aggj1(k,l)
2151 aggi(k,l)=-aggi(k,l)
2152 aggi1(k,l)=-aggi1(k,l)
2153 aggj(k,l)=-aggj(k,l)
2154 aggj1(k,l)=-aggj1(k,l)
2160 IF (wel_loc.gt.0.0d0) THEN
2161 C Contribution to the local-electrostatic energy coming from the i-j pair
2162 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2164 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2165 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2166 eel_loc=eel_loc+eel_loc_ij
2167 C Partial derivatives in virtual-bond dihedral angles gamma
2170 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2171 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2172 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2173 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2174 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2175 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2176 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2177 cd write(iout,*) 'agg ',agg
2178 cd write(iout,*) 'aggi ',aggi
2179 cd write(iout,*) 'aggi1',aggi1
2180 cd write(iout,*) 'aggj ',aggj
2181 cd write(iout,*) 'aggj1',aggj1
2183 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2185 ggg(l)=agg(l,1)*muij(1)+
2186 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2190 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2193 C Remaining derivatives of eello
2195 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2196 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2197 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2198 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2199 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2200 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2201 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2202 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2206 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2207 C Contributions from turns
2212 call eturn34(i,j,eello_turn3,eello_turn4)
2214 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2215 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2217 C Calculate the contact function. The ith column of the array JCONT will
2218 C contain the numbers of atoms that make contacts with the atom I (of numbers
2219 C greater than I). The arrays FACONT and GACONT will contain the values of
2220 C the contact function and its derivative.
2221 c r0ij=1.02D0*rpp(iteli,itelj)
2222 c r0ij=1.11D0*rpp(iteli,itelj)
2223 r0ij=2.20D0*rpp(iteli,itelj)
2224 c r0ij=1.55D0*rpp(iteli,itelj)
2225 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2226 if (fcont.gt.0.0D0) then
2227 num_conti=num_conti+1
2228 if (num_conti.gt.maxconts) then
2229 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2230 & ' will skip next contacts for this conf.'
2232 jcont_hb(num_conti,i)=j
2233 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2234 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2235 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2237 d_cont(num_conti,i)=rij
2238 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2239 C --- Electrostatic-interaction matrix ---
2240 a_chuj(1,1,num_conti,i)=a22
2241 a_chuj(1,2,num_conti,i)=a23
2242 a_chuj(2,1,num_conti,i)=a32
2243 a_chuj(2,2,num_conti,i)=a33
2244 C --- Gradient of rij
2246 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2249 c a_chuj(1,1,num_conti,i)=-0.61d0
2250 c a_chuj(1,2,num_conti,i)= 0.4d0
2251 c a_chuj(2,1,num_conti,i)= 0.65d0
2252 c a_chuj(2,2,num_conti,i)= 0.50d0
2253 c else if (i.eq.2) then
2254 c a_chuj(1,1,num_conti,i)= 0.0d0
2255 c a_chuj(1,2,num_conti,i)= 0.0d0
2256 c a_chuj(2,1,num_conti,i)= 0.0d0
2257 c a_chuj(2,2,num_conti,i)= 0.0d0
2259 C --- and its gradients
2260 cd write (iout,*) 'i',i,' j',j
2262 cd write (iout,*) 'iii 1 kkk',kkk
2263 cd write (iout,*) agg(kkk,:)
2266 cd write (iout,*) 'iii 2 kkk',kkk
2267 cd write (iout,*) aggi(kkk,:)
2270 cd write (iout,*) 'iii 3 kkk',kkk
2271 cd write (iout,*) aggi1(kkk,:)
2274 cd write (iout,*) 'iii 4 kkk',kkk
2275 cd write (iout,*) aggj(kkk,:)
2278 cd write (iout,*) 'iii 5 kkk',kkk
2279 cd write (iout,*) aggj1(kkk,:)
2286 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2287 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2288 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2289 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2290 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2292 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2298 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2299 C Calculate contact energies
2301 wij=cosa-3.0D0*cosb*cosg
2304 c fac3=dsqrt(-ael6i)/r0ij**3
2305 fac3=dsqrt(-ael6i)*r3ij
2306 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2307 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2309 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2310 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2311 C Diagnostics. Comment out or remove after debugging!
2312 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2313 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2314 c ees0m(num_conti,i)=0.0D0
2316 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2317 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2318 facont_hb(num_conti,i)=fcont
2320 C Angular derivatives of the contact function
2321 ees0pij1=fac3/ees0pij
2322 ees0mij1=fac3/ees0mij
2323 fac3p=-3.0D0*fac3*rrmij
2324 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2325 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2327 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2328 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2329 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2330 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2331 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2332 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2333 ecosap=ecosa1+ecosa2
2334 ecosbp=ecosb1+ecosb2
2335 ecosgp=ecosg1+ecosg2
2336 ecosam=ecosa1-ecosa2
2337 ecosbm=ecosb1-ecosb2
2338 ecosgm=ecosg1-ecosg2
2347 fprimcont=fprimcont/rij
2348 cd facont_hb(num_conti,i)=1.0D0
2349 C Following line is for diagnostics.
2352 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2353 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2356 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2357 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2359 gggp(1)=gggp(1)+ees0pijp*xj
2360 gggp(2)=gggp(2)+ees0pijp*yj
2361 gggp(3)=gggp(3)+ees0pijp*zj
2362 gggm(1)=gggm(1)+ees0mijp*xj
2363 gggm(2)=gggm(2)+ees0mijp*yj
2364 gggm(3)=gggm(3)+ees0mijp*zj
2365 C Derivatives due to the contact function
2366 gacont_hbr(1,num_conti,i)=fprimcont*xj
2367 gacont_hbr(2,num_conti,i)=fprimcont*yj
2368 gacont_hbr(3,num_conti,i)=fprimcont*zj
2370 ghalfp=0.5D0*gggp(k)
2371 ghalfm=0.5D0*gggm(k)
2372 gacontp_hb1(k,num_conti,i)=ghalfp
2373 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2374 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2375 gacontp_hb2(k,num_conti,i)=ghalfp
2376 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2377 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2378 gacontp_hb3(k,num_conti,i)=gggp(k)
2379 gacontm_hb1(k,num_conti,i)=ghalfm
2380 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2381 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2382 gacontm_hb2(k,num_conti,i)=ghalfm
2383 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2384 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2385 gacontm_hb3(k,num_conti,i)=gggm(k)
2388 C Diagnostics. Comment out or remove after debugging!
2390 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2391 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2392 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2393 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2394 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2395 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2398 endif ! num_conti.le.maxconts
2403 num_cont_hb(i)=num_conti
2407 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2408 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2410 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2411 ccc eel_loc=eel_loc+eello_turn3
2414 C-----------------------------------------------------------------------------
2415 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2416 C Third- and fourth-order contributions from turns
2417 implicit real*8 (a-h,o-z)
2418 include 'DIMENSIONS'
2419 include 'sizesclu.dat'
2420 include 'COMMON.IOUNITS'
2421 include 'COMMON.GEO'
2422 include 'COMMON.VAR'
2423 include 'COMMON.LOCAL'
2424 include 'COMMON.CHAIN'
2425 include 'COMMON.DERIV'
2426 include 'COMMON.INTERACT'
2427 include 'COMMON.CONTACTS'
2428 include 'COMMON.TORSION'
2429 include 'COMMON.VECTORS'
2430 include 'COMMON.FFIELD'
2432 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2433 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2434 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2435 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2436 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2437 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2439 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2441 C Third-order contributions
2448 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2449 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2450 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2451 call transpose2(auxmat(1,1),auxmat1(1,1))
2452 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2453 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2454 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2455 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2456 cd & ' eello_turn3_num',4*eello_turn3_num
2458 C Derivatives in gamma(i)
2459 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2460 call transpose2(auxmat2(1,1),pizda(1,1))
2461 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2462 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2463 C Derivatives in gamma(i+1)
2464 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2465 call transpose2(auxmat2(1,1),pizda(1,1))
2466 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2467 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2468 & +0.5d0*(pizda(1,1)+pizda(2,2))
2469 C Cartesian derivatives
2471 a_temp(1,1)=aggi(l,1)
2472 a_temp(1,2)=aggi(l,2)
2473 a_temp(2,1)=aggi(l,3)
2474 a_temp(2,2)=aggi(l,4)
2475 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2476 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2477 & +0.5d0*(pizda(1,1)+pizda(2,2))
2478 a_temp(1,1)=aggi1(l,1)
2479 a_temp(1,2)=aggi1(l,2)
2480 a_temp(2,1)=aggi1(l,3)
2481 a_temp(2,2)=aggi1(l,4)
2482 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2483 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2484 & +0.5d0*(pizda(1,1)+pizda(2,2))
2485 a_temp(1,1)=aggj(l,1)
2486 a_temp(1,2)=aggj(l,2)
2487 a_temp(2,1)=aggj(l,3)
2488 a_temp(2,2)=aggj(l,4)
2489 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2490 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2491 & +0.5d0*(pizda(1,1)+pizda(2,2))
2492 a_temp(1,1)=aggj1(l,1)
2493 a_temp(1,2)=aggj1(l,2)
2494 a_temp(2,1)=aggj1(l,3)
2495 a_temp(2,2)=aggj1(l,4)
2496 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2497 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2498 & +0.5d0*(pizda(1,1)+pizda(2,2))
2501 else if (j.eq.i+3) then
2502 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2504 C Fourth-order contributions
2512 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2513 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2514 iti1=itortyp(itype(i+1))
2515 iti2=itortyp(itype(i+2))
2516 iti3=itortyp(itype(i+3))
2517 call transpose2(EUg(1,1,i+1),e1t(1,1))
2518 call transpose2(Eug(1,1,i+2),e2t(1,1))
2519 call transpose2(Eug(1,1,i+3),e3t(1,1))
2520 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2521 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2522 s1=scalar2(b1(1,iti2),auxvec(1))
2523 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2524 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2525 s2=scalar2(b1(1,iti1),auxvec(1))
2526 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2527 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2528 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2529 eello_turn4=eello_turn4-(s1+s2+s3)
2530 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2531 cd & ' eello_turn4_num',8*eello_turn4_num
2532 C Derivatives in gamma(i)
2534 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2535 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2536 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2537 s1=scalar2(b1(1,iti2),auxvec(1))
2538 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2539 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2540 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2541 C Derivatives in gamma(i+1)
2542 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2543 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2544 s2=scalar2(b1(1,iti1),auxvec(1))
2545 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2546 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2547 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2548 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2549 C Derivatives in gamma(i+2)
2550 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2551 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2552 s1=scalar2(b1(1,iti2),auxvec(1))
2553 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2554 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2555 s2=scalar2(b1(1,iti1),auxvec(1))
2556 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2557 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2558 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2559 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2560 C Cartesian derivatives
2561 C Derivatives of this turn contributions in DC(i+2)
2562 if (j.lt.nres-1) then
2564 a_temp(1,1)=agg(l,1)
2565 a_temp(1,2)=agg(l,2)
2566 a_temp(2,1)=agg(l,3)
2567 a_temp(2,2)=agg(l,4)
2568 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2569 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2570 s1=scalar2(b1(1,iti2),auxvec(1))
2571 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2572 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2573 s2=scalar2(b1(1,iti1),auxvec(1))
2574 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2575 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2576 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2578 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2581 C Remaining derivatives of this turn contribution
2583 a_temp(1,1)=aggi(l,1)
2584 a_temp(1,2)=aggi(l,2)
2585 a_temp(2,1)=aggi(l,3)
2586 a_temp(2,2)=aggi(l,4)
2587 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2588 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2589 s1=scalar2(b1(1,iti2),auxvec(1))
2590 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2591 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2592 s2=scalar2(b1(1,iti1),auxvec(1))
2593 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2594 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2595 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2596 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2597 a_temp(1,1)=aggi1(l,1)
2598 a_temp(1,2)=aggi1(l,2)
2599 a_temp(2,1)=aggi1(l,3)
2600 a_temp(2,2)=aggi1(l,4)
2601 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2602 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2603 s1=scalar2(b1(1,iti2),auxvec(1))
2604 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2605 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2606 s2=scalar2(b1(1,iti1),auxvec(1))
2607 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2608 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2609 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2610 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2611 a_temp(1,1)=aggj(l,1)
2612 a_temp(1,2)=aggj(l,2)
2613 a_temp(2,1)=aggj(l,3)
2614 a_temp(2,2)=aggj(l,4)
2615 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2616 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2617 s1=scalar2(b1(1,iti2),auxvec(1))
2618 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2619 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2620 s2=scalar2(b1(1,iti1),auxvec(1))
2621 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2622 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2623 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2624 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2625 a_temp(1,1)=aggj1(l,1)
2626 a_temp(1,2)=aggj1(l,2)
2627 a_temp(2,1)=aggj1(l,3)
2628 a_temp(2,2)=aggj1(l,4)
2629 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2630 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2631 s1=scalar2(b1(1,iti2),auxvec(1))
2632 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2633 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2634 s2=scalar2(b1(1,iti1),auxvec(1))
2635 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2636 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2637 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2638 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2644 C-----------------------------------------------------------------------------
2645 subroutine vecpr(u,v,w)
2646 implicit real*8(a-h,o-z)
2647 dimension u(3),v(3),w(3)
2648 w(1)=u(2)*v(3)-u(3)*v(2)
2649 w(2)=-u(1)*v(3)+u(3)*v(1)
2650 w(3)=u(1)*v(2)-u(2)*v(1)
2653 C-----------------------------------------------------------------------------
2654 subroutine unormderiv(u,ugrad,unorm,ungrad)
2655 C This subroutine computes the derivatives of a normalized vector u, given
2656 C the derivatives computed without normalization conditions, ugrad. Returns
2659 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2660 double precision vec(3)
2661 double precision scalar
2663 c write (2,*) 'ugrad',ugrad
2666 vec(i)=scalar(ugrad(1,i),u(1))
2668 c write (2,*) 'vec',vec
2671 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2674 c write (2,*) 'ungrad',ungrad
2677 C-----------------------------------------------------------------------------
2678 subroutine escp(evdw2,evdw2_14)
2680 C This subroutine calculates the excluded-volume interaction energy between
2681 C peptide-group centers and side chains and its gradient in virtual-bond and
2682 C side-chain vectors.
2684 implicit real*8 (a-h,o-z)
2685 include 'DIMENSIONS'
2686 include 'sizesclu.dat'
2687 include 'COMMON.GEO'
2688 include 'COMMON.VAR'
2689 include 'COMMON.LOCAL'
2690 include 'COMMON.CHAIN'
2691 include 'COMMON.DERIV'
2692 include 'COMMON.INTERACT'
2693 include 'COMMON.FFIELD'
2694 include 'COMMON.IOUNITS'
2698 cd print '(a)','Enter ESCP'
2699 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2700 c & ' scal14',scal14
2701 do i=iatscp_s,iatscp_e
2703 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2704 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2705 if (iteli.eq.0) goto 1225
2706 xi=0.5D0*(c(1,i)+c(1,i+1))
2707 yi=0.5D0*(c(2,i)+c(2,i+1))
2708 zi=0.5D0*(c(3,i)+c(3,i+1))
2710 do iint=1,nscp_gr(i)
2712 do j=iscpstart(i,iint),iscpend(i,iint)
2714 C Uncomment following three lines for SC-p interactions
2718 C Uncomment following three lines for Ca-p interactions
2722 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2724 e1=fac*fac*aad(itypj,iteli)
2725 e2=fac*bad(itypj,iteli)
2726 if (iabs(j-i) .le. 2) then
2729 evdw2_14=evdw2_14+e1+e2
2732 c write (iout,*) i,j,evdwij
2736 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2738 fac=-(evdwij+e1)*rrij
2743 cd write (iout,*) 'j<i'
2744 C Uncomment following three lines for SC-p interactions
2746 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2749 cd write (iout,*) 'j>i'
2752 C Uncomment following line for SC-p interactions
2753 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2757 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2761 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2762 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2765 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2775 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2776 gradx_scp(j,i)=expon*gradx_scp(j,i)
2779 C******************************************************************************
2783 C To save time the factor EXPON has been extracted from ALL components
2784 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2787 C******************************************************************************
2790 C--------------------------------------------------------------------------
2791 subroutine edis(ehpb)
2793 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2795 implicit real*8 (a-h,o-z)
2796 include 'DIMENSIONS'
2797 include 'sizesclu.dat'
2798 include 'COMMON.SBRIDGE'
2799 include 'COMMON.CHAIN'
2800 include 'COMMON.DERIV'
2801 include 'COMMON.VAR'
2802 include 'COMMON.INTERACT'
2805 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2806 cd print *,'link_start=',link_start,' link_end=',link_end
2807 if (link_end.eq.0) return
2808 do i=link_start,link_end
2809 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2810 C CA-CA distance used in regularization of structure.
2813 C iii and jjj point to the residues for which the distance is assigned.
2814 if (ii.gt.nres) then
2821 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2822 C distance and angle dependent SS bond potential.
2823 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2824 call ssbond_ene(iii,jjj,eij)
2827 C Calculate the distance between the two points and its difference from the
2831 C Get the force constant corresponding to this distance.
2833 C Calculate the contribution to energy.
2834 ehpb=ehpb+waga*rdis*rdis
2836 C Evaluate gradient.
2839 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2840 cd & ' waga=',waga,' fac=',fac
2842 ggg(j)=fac*(c(j,jj)-c(j,ii))
2844 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2845 C If this is a SC-SC distance, we need to calculate the contributions to the
2846 C Cartesian gradient in the SC vectors (ghpbx).
2849 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2850 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2855 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2863 C--------------------------------------------------------------------------
2864 subroutine ssbond_ene(i,j,eij)
2866 C Calculate the distance and angle dependent SS-bond potential energy
2867 C using a free-energy function derived based on RHF/6-31G** ab initio
2868 C calculations of diethyl disulfide.
2870 C A. Liwo and U. Kozlowska, 11/24/03
2872 implicit real*8 (a-h,o-z)
2873 include 'DIMENSIONS'
2874 include 'sizesclu.dat'
2875 include 'COMMON.SBRIDGE'
2876 include 'COMMON.CHAIN'
2877 include 'COMMON.DERIV'
2878 include 'COMMON.LOCAL'
2879 include 'COMMON.INTERACT'
2880 include 'COMMON.VAR'
2881 include 'COMMON.IOUNITS'
2882 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2887 dxi=dc_norm(1,nres+i)
2888 dyi=dc_norm(2,nres+i)
2889 dzi=dc_norm(3,nres+i)
2890 dsci_inv=dsc_inv(itypi)
2892 dscj_inv=dsc_inv(itypj)
2896 dxj=dc_norm(1,nres+j)
2897 dyj=dc_norm(2,nres+j)
2898 dzj=dc_norm(3,nres+j)
2899 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2904 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2905 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2906 om12=dxi*dxj+dyi*dyj+dzi*dzj
2908 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2909 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2915 deltat12=om2-om1+2.0d0
2917 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2918 & +akct*deltad*deltat12
2919 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2920 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2921 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2922 c & " deltat12",deltat12," eij",eij
2923 ed=2*akcm*deltad+akct*deltat12
2925 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
2926 eom1=-2*akth*deltat1-pom1-om2*pom2
2927 eom2= 2*akth*deltat2+pom1-om1*pom2
2930 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2933 ghpbx(k,i)=ghpbx(k,i)-gg(k)
2934 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
2935 ghpbx(k,j)=ghpbx(k,j)+gg(k)
2936 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
2939 C Calculate the components of the gradient in DC and X
2943 ghpbc(l,k)=ghpbc(l,k)+gg(l)
2948 C--------------------------------------------------------------------------
2949 subroutine ebond(estr)
2951 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
2953 implicit real*8 (a-h,o-z)
2954 include 'DIMENSIONS'
2955 include 'COMMON.LOCAL'
2956 include 'COMMON.GEO'
2957 include 'COMMON.INTERACT'
2958 include 'COMMON.DERIV'
2959 include 'COMMON.VAR'
2960 include 'COMMON.CHAIN'
2961 include 'COMMON.IOUNITS'
2962 include 'COMMON.NAMES'
2963 include 'COMMON.FFIELD'
2964 include 'COMMON.CONTROL'
2965 double precision u(3),ud(3)
2968 diff = vbld(i)-vbldp0
2969 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
2972 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
2977 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
2984 diff=vbld(i+nres)-vbldsc0(1,iti)
2985 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
2986 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
2987 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
2989 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
2993 diff=vbld(i+nres)-vbldsc0(j,iti)
2994 ud(j)=aksc(j,iti)*diff
2995 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3009 uprod2=uprod2*u(k)*u(k)
3013 usumsqder=usumsqder+ud(j)*uprod2
3015 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3016 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3017 estr=estr+uprod/usum
3019 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3027 C--------------------------------------------------------------------------
3028 subroutine ebend(etheta)
3030 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3031 C angles gamma and its derivatives in consecutive thetas and gammas.
3033 implicit real*8 (a-h,o-z)
3034 include 'DIMENSIONS'
3035 include 'sizesclu.dat'
3036 include 'COMMON.LOCAL'
3037 include 'COMMON.GEO'
3038 include 'COMMON.INTERACT'
3039 include 'COMMON.DERIV'
3040 include 'COMMON.VAR'
3041 include 'COMMON.CHAIN'
3042 include 'COMMON.IOUNITS'
3043 include 'COMMON.NAMES'
3044 include 'COMMON.FFIELD'
3045 common /calcthet/ term1,term2,termm,diffak,ratak,
3046 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3047 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3048 double precision y(2),z(2)
3050 time11=dexp(-2*time)
3053 c write (iout,*) "nres",nres
3054 c write (*,'(a,i2)') 'EBEND ICG=',icg
3055 c write (iout,*) ithet_start,ithet_end
3056 do i=ithet_start,ithet_end
3057 C Zero the energy function and its derivative at 0 or pi.
3058 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3060 c if (i.gt.ithet_start .and.
3061 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3062 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3070 c if (i.lt.nres .and. itel(i).ne.0) then
3082 call proc_proc(phii,icrc)
3083 if (icrc.eq.1) phii=150.0
3097 call proc_proc(phii1,icrc)
3098 if (icrc.eq.1) phii1=150.0
3110 C Calculate the "mean" value of theta from the part of the distribution
3111 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3112 C In following comments this theta will be referred to as t_c.
3113 thet_pred_mean=0.0d0
3117 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3119 c write (iout,*) "thet_pred_mean",thet_pred_mean
3120 dthett=thet_pred_mean*ssd
3121 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3122 c write (iout,*) "thet_pred_mean",thet_pred_mean
3123 C Derivatives of the "mean" values in gamma1 and gamma2.
3124 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3125 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3126 if (theta(i).gt.pi-delta) then
3127 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3129 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3130 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3131 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3133 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3135 else if (theta(i).lt.delta) then
3136 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3137 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3138 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3140 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3141 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3144 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3147 etheta=etheta+ethetai
3148 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3149 c & rad2deg*phii,rad2deg*phii1,ethetai
3150 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3151 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3152 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3155 C Ufff.... We've done all this!!!
3158 C---------------------------------------------------------------------------
3159 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3161 implicit real*8 (a-h,o-z)
3162 include 'DIMENSIONS'
3163 include 'COMMON.LOCAL'
3164 include 'COMMON.IOUNITS'
3165 common /calcthet/ term1,term2,termm,diffak,ratak,
3166 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3167 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3168 C Calculate the contributions to both Gaussian lobes.
3169 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3170 C The "polynomial part" of the "standard deviation" of this part of
3174 sig=sig*thet_pred_mean+polthet(j,it)
3176 C Derivative of the "interior part" of the "standard deviation of the"
3177 C gamma-dependent Gaussian lobe in t_c.
3178 sigtc=3*polthet(3,it)
3180 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3183 C Set the parameters of both Gaussian lobes of the distribution.
3184 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3185 fac=sig*sig+sigc0(it)
3188 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3189 sigsqtc=-4.0D0*sigcsq*sigtc
3190 c print *,i,sig,sigtc,sigsqtc
3191 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3192 sigtc=-sigtc/(fac*fac)
3193 C Following variable is sigma(t_c)**(-2)
3194 sigcsq=sigcsq*sigcsq
3196 sig0inv=1.0D0/sig0i**2
3197 delthec=thetai-thet_pred_mean
3198 delthe0=thetai-theta0i
3199 term1=-0.5D0*sigcsq*delthec*delthec
3200 term2=-0.5D0*sig0inv*delthe0*delthe0
3201 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3202 C NaNs in taking the logarithm. We extract the largest exponent which is added
3203 C to the energy (this being the log of the distribution) at the end of energy
3204 C term evaluation for this virtual-bond angle.
3205 if (term1.gt.term2) then
3207 term2=dexp(term2-termm)
3211 term1=dexp(term1-termm)
3214 C The ratio between the gamma-independent and gamma-dependent lobes of
3215 C the distribution is a Gaussian function of thet_pred_mean too.
3216 diffak=gthet(2,it)-thet_pred_mean
3217 ratak=diffak/gthet(3,it)**2
3218 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3219 C Let's differentiate it in thet_pred_mean NOW.
3221 C Now put together the distribution terms to make complete distribution.
3222 termexp=term1+ak*term2
3223 termpre=sigc+ak*sig0i
3224 C Contribution of the bending energy from this theta is just the -log of
3225 C the sum of the contributions from the two lobes and the pre-exponential
3226 C factor. Simple enough, isn't it?
3227 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3228 C NOW the derivatives!!!
3229 C 6/6/97 Take into account the deformation.
3230 E_theta=(delthec*sigcsq*term1
3231 & +ak*delthe0*sig0inv*term2)/termexp
3232 E_tc=((sigtc+aktc*sig0i)/termpre
3233 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3234 & aktc*term2)/termexp)
3237 c-----------------------------------------------------------------------------
3238 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3239 implicit real*8 (a-h,o-z)
3240 include 'DIMENSIONS'
3241 include 'COMMON.LOCAL'
3242 include 'COMMON.IOUNITS'
3243 common /calcthet/ term1,term2,termm,diffak,ratak,
3244 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3245 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3246 delthec=thetai-thet_pred_mean
3247 delthe0=thetai-theta0i
3248 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3249 t3 = thetai-thet_pred_mean
3253 t14 = t12+t6*sigsqtc
3255 t21 = thetai-theta0i
3261 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3262 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3263 & *(-t12*t9-ak*sig0inv*t27)
3267 C--------------------------------------------------------------------------
3268 subroutine ebend(etheta)
3270 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3271 C angles gamma and its derivatives in consecutive thetas and gammas.
3272 C ab initio-derived potentials from
3273 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3275 implicit real*8 (a-h,o-z)
3276 include 'DIMENSIONS'
3277 include 'COMMON.LOCAL'
3278 include 'COMMON.GEO'
3279 include 'COMMON.INTERACT'
3280 include 'COMMON.DERIV'
3281 include 'COMMON.VAR'
3282 include 'COMMON.CHAIN'
3283 include 'COMMON.IOUNITS'
3284 include 'COMMON.NAMES'
3285 include 'COMMON.FFIELD'
3286 include 'COMMON.CONTROL'
3287 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3288 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3289 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3290 & sinph1ph2(maxdouble,maxdouble)
3291 logical lprn /.false./, lprn1 /.false./
3293 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3294 do i=ithet_start,ithet_end
3298 theti2=0.5d0*theta(i)
3299 ityp2=ithetyp(itype(i-1))
3301 coskt(k)=dcos(k*theti2)
3302 sinkt(k)=dsin(k*theti2)
3307 if (phii.ne.phii) phii=150.0
3311 ityp1=ithetyp(itype(i-2))
3313 cosph1(k)=dcos(k*phii)
3314 sinph1(k)=dsin(k*phii)
3327 if (phii1.ne.phii1) phii1=150.0
3332 ityp3=ithetyp(itype(i))
3334 cosph2(k)=dcos(k*phii1)
3335 sinph2(k)=dsin(k*phii1)
3345 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3346 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3348 ethetai=aa0thet(ityp1,ityp2,ityp3)
3351 ccl=cosph1(l)*cosph2(k-l)
3352 ssl=sinph1(l)*sinph2(k-l)
3353 scl=sinph1(l)*cosph2(k-l)
3354 csl=cosph1(l)*sinph2(k-l)
3355 cosph1ph2(l,k)=ccl-ssl
3356 cosph1ph2(k,l)=ccl+ssl
3357 sinph1ph2(l,k)=scl+csl
3358 sinph1ph2(k,l)=scl-csl
3362 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3363 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3364 write (iout,*) "coskt and sinkt"
3366 write (iout,*) k,coskt(k),sinkt(k)
3370 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3371 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3374 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3375 & " ethetai",ethetai
3378 write (iout,*) "cosph and sinph"
3380 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3382 write (iout,*) "cosph1ph2 and sinph2ph2"
3385 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3386 & sinph1ph2(l,k),sinph1ph2(k,l)
3389 write(iout,*) "ethetai",ethetai
3393 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3394 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3395 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3396 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3397 ethetai=ethetai+sinkt(m)*aux
3398 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3399 dephii=dephii+k*sinkt(m)*(
3400 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3401 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3402 dephii1=dephii1+k*sinkt(m)*(
3403 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3404 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3406 & write (iout,*) "m",m," k",k," bbthet",
3407 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3408 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3409 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3410 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3414 & write(iout,*) "ethetai",ethetai
3418 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3419 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3420 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3421 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3422 ethetai=ethetai+sinkt(m)*aux
3423 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3424 dephii=dephii+l*sinkt(m)*(
3425 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3426 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3427 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3428 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3429 dephii1=dephii1+(k-l)*sinkt(m)*(
3430 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3431 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3432 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3433 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3435 write (iout,*) "m",m," k",k," l",l," ffthet",
3436 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3437 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3438 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3439 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3440 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3441 & cosph1ph2(k,l)*sinkt(m),
3442 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3448 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3449 & i,theta(i)*rad2deg,phii*rad2deg,
3450 & phii1*rad2deg,ethetai
3451 etheta=etheta+ethetai
3452 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3453 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3454 gloc(nphi+i-2,icg)=wang*dethetai
3460 c-----------------------------------------------------------------------------
3461 subroutine esc(escloc)
3462 C Calculate the local energy of a side chain and its derivatives in the
3463 C corresponding virtual-bond valence angles THETA and the spherical angles
3465 implicit real*8 (a-h,o-z)
3466 include 'DIMENSIONS'
3467 include 'sizesclu.dat'
3468 include 'COMMON.GEO'
3469 include 'COMMON.LOCAL'
3470 include 'COMMON.VAR'
3471 include 'COMMON.INTERACT'
3472 include 'COMMON.DERIV'
3473 include 'COMMON.CHAIN'
3474 include 'COMMON.IOUNITS'
3475 include 'COMMON.NAMES'
3476 include 'COMMON.FFIELD'
3477 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3478 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3479 common /sccalc/ time11,time12,time112,theti,it,nlobit
3482 c write (iout,'(a)') 'ESC'
3483 do i=loc_start,loc_end
3485 if (it.eq.10) goto 1
3487 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3488 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3489 theti=theta(i+1)-pipol
3493 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3495 if (x(2).gt.pi-delta) then
3499 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3501 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3502 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3504 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3505 & ddersc0(1),dersc(1))
3506 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3507 & ddersc0(3),dersc(3))
3509 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3511 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3512 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3513 & dersc0(2),esclocbi,dersc02)
3514 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3516 call splinthet(x(2),0.5d0*delta,ss,ssd)
3521 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3523 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3524 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3526 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3528 c write (iout,*) escloci
3529 else if (x(2).lt.delta) then
3533 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3535 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3536 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3538 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3539 & ddersc0(1),dersc(1))
3540 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3541 & ddersc0(3),dersc(3))
3543 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3545 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3546 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3547 & dersc0(2),esclocbi,dersc02)
3548 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3553 call splinthet(x(2),0.5d0*delta,ss,ssd)
3555 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3557 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3558 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3560 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3561 c write (iout,*) escloci
3563 call enesc(x,escloci,dersc,ddummy,.false.)
3566 escloc=escloc+escloci
3567 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3569 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3571 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3572 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3577 C---------------------------------------------------------------------------
3578 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3579 implicit real*8 (a-h,o-z)
3580 include 'DIMENSIONS'
3581 include 'COMMON.GEO'
3582 include 'COMMON.LOCAL'
3583 include 'COMMON.IOUNITS'
3584 common /sccalc/ time11,time12,time112,theti,it,nlobit
3585 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3586 double precision contr(maxlob,-1:1)
3588 c write (iout,*) 'it=',it,' nlobit=',nlobit
3592 if (mixed) ddersc(j)=0.0d0
3596 C Because of periodicity of the dependence of the SC energy in omega we have
3597 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3598 C To avoid underflows, first compute & store the exponents.
3606 z(k)=x(k)-censc(k,j,it)
3611 Axk=Axk+gaussc(l,k,j,it)*z(l)
3617 expfac=expfac+Ax(k,j,iii)*z(k)
3625 C As in the case of ebend, we want to avoid underflows in exponentiation and
3626 C subsequent NaNs and INFs in energy calculation.
3627 C Find the largest exponent
3631 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3635 cd print *,'it=',it,' emin=',emin
3637 C Compute the contribution to SC energy and derivatives
3641 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3642 cd print *,'j=',j,' expfac=',expfac
3643 escloc_i=escloc_i+expfac
3645 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3649 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3650 & +gaussc(k,2,j,it))*expfac
3657 dersc(1)=dersc(1)/cos(theti)**2
3658 ddersc(1)=ddersc(1)/cos(theti)**2
3661 escloci=-(dlog(escloc_i)-emin)
3663 dersc(j)=dersc(j)/escloc_i
3667 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3672 C------------------------------------------------------------------------------
3673 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3674 implicit real*8 (a-h,o-z)
3675 include 'DIMENSIONS'
3676 include 'COMMON.GEO'
3677 include 'COMMON.LOCAL'
3678 include 'COMMON.IOUNITS'
3679 common /sccalc/ time11,time12,time112,theti,it,nlobit
3680 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3681 double precision contr(maxlob)
3692 z(k)=x(k)-censc(k,j,it)
3698 Axk=Axk+gaussc(l,k,j,it)*z(l)
3704 expfac=expfac+Ax(k,j)*z(k)
3709 C As in the case of ebend, we want to avoid underflows in exponentiation and
3710 C subsequent NaNs and INFs in energy calculation.
3711 C Find the largest exponent
3714 if (emin.gt.contr(j)) emin=contr(j)
3718 C Compute the contribution to SC energy and derivatives
3722 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3723 escloc_i=escloc_i+expfac
3725 dersc(k)=dersc(k)+Ax(k,j)*expfac
3727 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3728 & +gaussc(1,2,j,it))*expfac
3732 dersc(1)=dersc(1)/cos(theti)**2
3733 dersc12=dersc12/cos(theti)**2
3734 escloci=-(dlog(escloc_i)-emin)
3736 dersc(j)=dersc(j)/escloc_i
3738 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3742 c----------------------------------------------------------------------------------
3743 subroutine esc(escloc)
3744 C Calculate the local energy of a side chain and its derivatives in the
3745 C corresponding virtual-bond valence angles THETA and the spherical angles
3746 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3747 C added by Urszula Kozlowska. 07/11/2007
3749 implicit real*8 (a-h,o-z)
3750 include 'DIMENSIONS'
3751 include 'COMMON.GEO'
3752 include 'COMMON.LOCAL'
3753 include 'COMMON.VAR'
3754 include 'COMMON.SCROT'
3755 include 'COMMON.INTERACT'
3756 include 'COMMON.DERIV'
3757 include 'COMMON.CHAIN'
3758 include 'COMMON.IOUNITS'
3759 include 'COMMON.NAMES'
3760 include 'COMMON.FFIELD'
3761 include 'COMMON.CONTROL'
3762 include 'COMMON.VECTORS'
3763 double precision x_prime(3),y_prime(3),z_prime(3)
3764 & , sumene,dsc_i,dp2_i,x(65),
3765 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3766 & de_dxx,de_dyy,de_dzz,de_dt
3767 double precision s1_t,s1_6_t,s2_t,s2_6_t
3769 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3770 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3771 & dt_dCi(3),dt_dCi1(3)
3772 common /sccalc/ time11,time12,time112,theti,it,nlobit
3775 do i=loc_start,loc_end
3776 costtab(i+1) =dcos(theta(i+1))
3777 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3778 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3779 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3780 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3781 cosfac=dsqrt(cosfac2)
3782 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3783 sinfac=dsqrt(sinfac2)
3785 if (it.eq.10) goto 1
3787 C Compute the axes of tghe local cartesian coordinates system; store in
3788 c x_prime, y_prime and z_prime
3795 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3796 C & dc_norm(3,i+nres)
3798 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3799 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3802 z_prime(j) = -uz(j,i-1)
3805 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3806 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3807 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3808 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3809 c & " xy",scalar(x_prime(1),y_prime(1)),
3810 c & " xz",scalar(x_prime(1),z_prime(1)),
3811 c & " yy",scalar(y_prime(1),y_prime(1)),
3812 c & " yz",scalar(y_prime(1),z_prime(1)),
3813 c & " zz",scalar(z_prime(1),z_prime(1))
3815 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3816 C to local coordinate system. Store in xx, yy, zz.
3822 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3823 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3824 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3831 C Compute the energy of the ith side cbain
3833 c write (2,*) "xx",xx," yy",yy," zz",zz
3836 x(j) = sc_parmin(j,it)
3839 Cc diagnostics - remove later
3841 yy1 = dsin(alph(2))*dcos(omeg(2))
3842 zz1 = -dsin(alph(2))*dsin(omeg(2))
3843 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3844 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3846 C," --- ", xx_w,yy_w,zz_w
3849 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3850 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3852 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3853 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3855 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3856 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3857 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3858 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3859 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3861 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3862 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3863 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3864 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3865 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3867 dsc_i = 0.743d0+x(61)
3869 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3870 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3871 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3872 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3873 s1=(1+x(63))/(0.1d0 + dscp1)
3874 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3875 s2=(1+x(65))/(0.1d0 + dscp2)
3876 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3877 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3878 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3879 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3881 c & dscp1,dscp2,sumene
3882 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3883 escloc = escloc + sumene
3884 c write (2,*) "escloc",escloc
3885 if (.not. calc_grad) goto 1
3888 C This section to check the numerical derivatives of the energy of ith side
3889 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3890 C #define DEBUG in the code to turn it on.
3892 write (2,*) "sumene =",sumene
3896 write (2,*) xx,yy,zz
3897 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3898 de_dxx_num=(sumenep-sumene)/aincr
3900 write (2,*) "xx+ sumene from enesc=",sumenep
3903 write (2,*) xx,yy,zz
3904 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3905 de_dyy_num=(sumenep-sumene)/aincr
3907 write (2,*) "yy+ sumene from enesc=",sumenep
3910 write (2,*) xx,yy,zz
3911 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3912 de_dzz_num=(sumenep-sumene)/aincr
3914 write (2,*) "zz+ sumene from enesc=",sumenep
3915 costsave=cost2tab(i+1)
3916 sintsave=sint2tab(i+1)
3917 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
3918 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
3919 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3920 de_dt_num=(sumenep-sumene)/aincr
3921 write (2,*) " t+ sumene from enesc=",sumenep
3922 cost2tab(i+1)=costsave
3923 sint2tab(i+1)=sintsave
3924 C End of diagnostics section.
3927 C Compute the gradient of esc
3929 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
3930 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
3931 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
3932 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
3933 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
3934 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
3935 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
3936 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
3937 pom1=(sumene3*sint2tab(i+1)+sumene1)
3938 & *(pom_s1/dscp1+pom_s16*dscp1**4)
3939 pom2=(sumene4*cost2tab(i+1)+sumene2)
3940 & *(pom_s2/dscp2+pom_s26*dscp2**4)
3941 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
3942 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
3943 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
3945 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
3946 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
3947 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
3949 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
3950 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
3951 & +(pom1+pom2)*pom_dx
3953 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
3956 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
3957 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
3958 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
3960 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
3961 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
3962 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
3963 & +x(59)*zz**2 +x(60)*xx*zz
3964 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
3965 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
3966 & +(pom1-pom2)*pom_dy
3968 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
3971 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
3972 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
3973 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
3974 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
3975 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
3976 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
3977 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
3978 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
3980 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
3983 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
3984 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
3985 & +pom1*pom_dt1+pom2*pom_dt2
3987 write(2,*), "de_dt = ", de_dt,de_dt_num
3991 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
3992 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
3993 cosfac2xx=cosfac2*xx
3994 sinfac2yy=sinfac2*yy
3996 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
3998 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4000 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4001 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4002 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4003 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4004 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4005 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4006 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4007 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4008 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4009 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4013 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4014 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4017 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4018 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4019 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4021 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4022 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4026 dXX_Ctab(k,i)=dXX_Ci(k)
4027 dXX_C1tab(k,i)=dXX_Ci1(k)
4028 dYY_Ctab(k,i)=dYY_Ci(k)
4029 dYY_C1tab(k,i)=dYY_Ci1(k)
4030 dZZ_Ctab(k,i)=dZZ_Ci(k)
4031 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4032 dXX_XYZtab(k,i)=dXX_XYZ(k)
4033 dYY_XYZtab(k,i)=dYY_XYZ(k)
4034 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4038 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4039 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4040 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4041 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4042 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4044 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4045 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4046 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4047 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4048 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4049 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4050 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4051 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4053 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4054 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4056 C to check gradient call subroutine check_grad
4063 c------------------------------------------------------------------------------
4064 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4066 C This procedure calculates two-body contact function g(rij) and its derivative:
4069 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4072 C where x=(rij-r0ij)/delta
4074 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4077 double precision rij,r0ij,eps0ij,fcont,fprimcont
4078 double precision x,x2,x4,delta
4082 if (x.lt.-1.0D0) then
4085 else if (x.le.1.0D0) then
4088 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4089 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4096 c------------------------------------------------------------------------------
4097 subroutine splinthet(theti,delta,ss,ssder)
4098 implicit real*8 (a-h,o-z)
4099 include 'DIMENSIONS'
4100 include 'sizesclu.dat'
4101 include 'COMMON.VAR'
4102 include 'COMMON.GEO'
4105 if (theti.gt.pipol) then
4106 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4108 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4113 c------------------------------------------------------------------------------
4114 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4116 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4117 double precision ksi,ksi2,ksi3,a1,a2,a3
4118 a1=fprim0*delta/(f1-f0)
4124 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4125 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4128 c------------------------------------------------------------------------------
4129 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4131 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4132 double precision ksi,ksi2,ksi3,a1,a2,a3
4137 a2=3*(f1x-f0x)-2*fprim0x*delta
4138 a3=fprim0x*delta-2*(f1x-f0x)
4139 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4142 C-----------------------------------------------------------------------------
4144 C-----------------------------------------------------------------------------
4145 subroutine etor(etors,edihcnstr,fact)
4146 implicit real*8 (a-h,o-z)
4147 include 'DIMENSIONS'
4148 include 'sizesclu.dat'
4149 include 'COMMON.VAR'
4150 include 'COMMON.GEO'
4151 include 'COMMON.LOCAL'
4152 include 'COMMON.TORSION'
4153 include 'COMMON.INTERACT'
4154 include 'COMMON.DERIV'
4155 include 'COMMON.CHAIN'
4156 include 'COMMON.NAMES'
4157 include 'COMMON.IOUNITS'
4158 include 'COMMON.FFIELD'
4159 include 'COMMON.TORCNSTR'
4161 C Set lprn=.true. for debugging
4165 do i=iphi_start,iphi_end
4166 itori=itortyp(itype(i-2))
4167 itori1=itortyp(itype(i-1))
4170 C Proline-Proline pair is a special case...
4171 if (itori.eq.3 .and. itori1.eq.3) then
4172 if (phii.gt.-dwapi3) then
4174 fac=1.0D0/(1.0D0-cosphi)
4175 etorsi=v1(1,3,3)*fac
4176 etorsi=etorsi+etorsi
4177 etors=etors+etorsi-v1(1,3,3)
4178 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4181 v1ij=v1(j+1,itori,itori1)
4182 v2ij=v2(j+1,itori,itori1)
4185 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4186 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4190 v1ij=v1(j,itori,itori1)
4191 v2ij=v2(j,itori,itori1)
4194 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4195 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4199 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4200 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4201 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4202 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4203 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4205 ! 6/20/98 - dihedral angle constraints
4208 itori=idih_constr(i)
4211 if (difi.gt.drange(i)) then
4213 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4214 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4215 else if (difi.lt.-drange(i)) then
4217 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4218 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4220 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4221 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4223 ! write (iout,*) 'edihcnstr',edihcnstr
4226 c------------------------------------------------------------------------------
4228 subroutine etor(etors,edihcnstr,fact)
4229 implicit real*8 (a-h,o-z)
4230 include 'DIMENSIONS'
4231 include 'sizesclu.dat'
4232 include 'COMMON.VAR'
4233 include 'COMMON.GEO'
4234 include 'COMMON.LOCAL'
4235 include 'COMMON.TORSION'
4236 include 'COMMON.INTERACT'
4237 include 'COMMON.DERIV'
4238 include 'COMMON.CHAIN'
4239 include 'COMMON.NAMES'
4240 include 'COMMON.IOUNITS'
4241 include 'COMMON.FFIELD'
4242 include 'COMMON.TORCNSTR'
4244 C Set lprn=.true. for debugging
4248 do i=iphi_start,iphi_end
4249 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4250 itori=itortyp(itype(i-2))
4251 itori1=itortyp(itype(i-1))
4254 C Regular cosine and sine terms
4255 do j=1,nterm(itori,itori1)
4256 v1ij=v1(j,itori,itori1)
4257 v2ij=v2(j,itori,itori1)
4260 etors=etors+v1ij*cosphi+v2ij*sinphi
4261 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4265 C E = SUM ----------------------------------- - v1
4266 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4268 cosphi=dcos(0.5d0*phii)
4269 sinphi=dsin(0.5d0*phii)
4270 do j=1,nlor(itori,itori1)
4271 vl1ij=vlor1(j,itori,itori1)
4272 vl2ij=vlor2(j,itori,itori1)
4273 vl3ij=vlor3(j,itori,itori1)
4274 pom=vl2ij*cosphi+vl3ij*sinphi
4275 pom1=1.0d0/(pom*pom+1.0d0)
4276 etors=etors+vl1ij*pom1
4278 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4280 C Subtract the constant term
4281 etors=etors-v0(itori,itori1)
4283 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4284 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4285 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4286 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4287 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4290 ! 6/20/98 - dihedral angle constraints
4294 itori=idih_constr(i)
4297 if (difi.gt.drange(i)) then
4299 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4300 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4301 else if (difi.lt.-drange(i)) then
4303 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4304 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4306 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4307 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4309 ! write (iout,*) 'edihcnstr',edihcnstr
4312 c----------------------------------------------------------------------------
4313 subroutine etor_d(etors_d,fact2)
4314 C 6/23/01 Compute double torsional energy
4315 implicit real*8 (a-h,o-z)
4316 include 'DIMENSIONS'
4317 include 'sizesclu.dat'
4318 include 'COMMON.VAR'
4319 include 'COMMON.GEO'
4320 include 'COMMON.LOCAL'
4321 include 'COMMON.TORSION'
4322 include 'COMMON.INTERACT'
4323 include 'COMMON.DERIV'
4324 include 'COMMON.CHAIN'
4325 include 'COMMON.NAMES'
4326 include 'COMMON.IOUNITS'
4327 include 'COMMON.FFIELD'
4328 include 'COMMON.TORCNSTR'
4330 C Set lprn=.true. for debugging
4334 do i=iphi_start,iphi_end-1
4335 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4337 itori=itortyp(itype(i-2))
4338 itori1=itortyp(itype(i-1))
4339 itori2=itortyp(itype(i))
4344 C Regular cosine and sine terms
4345 do j=1,ntermd_1(itori,itori1,itori2)
4346 v1cij=v1c(1,j,itori,itori1,itori2)
4347 v1sij=v1s(1,j,itori,itori1,itori2)
4348 v2cij=v1c(2,j,itori,itori1,itori2)
4349 v2sij=v1s(2,j,itori,itori1,itori2)
4350 cosphi1=dcos(j*phii)
4351 sinphi1=dsin(j*phii)
4352 cosphi2=dcos(j*phii1)
4353 sinphi2=dsin(j*phii1)
4354 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4355 & v2cij*cosphi2+v2sij*sinphi2
4356 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4357 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4359 do k=2,ntermd_2(itori,itori1,itori2)
4361 v1cdij = v2c(k,l,itori,itori1,itori2)
4362 v2cdij = v2c(l,k,itori,itori1,itori2)
4363 v1sdij = v2s(k,l,itori,itori1,itori2)
4364 v2sdij = v2s(l,k,itori,itori1,itori2)
4365 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4366 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4367 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4368 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4369 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4370 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4371 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4372 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4373 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4374 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4377 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4378 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4384 c------------------------------------------------------------------------------
4385 subroutine eback_sc_corr(esccor,fact)
4386 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4387 c conformational states; temporarily implemented as differences
4388 c between UNRES torsional potentials (dependent on three types of
4389 c residues) and the torsional potentials dependent on all 20 types
4390 c of residues computed from AM1 energy surfaces of terminally-blocked
4391 c amino-acid residues.
4392 implicit real*8 (a-h,o-z)
4393 include 'DIMENSIONS'
4394 include 'COMMON.VAR'
4395 include 'COMMON.GEO'
4396 include 'COMMON.LOCAL'
4397 include 'COMMON.TORSION'
4398 include 'COMMON.SCCOR'
4399 include 'COMMON.INTERACT'
4400 include 'COMMON.DERIV'
4401 include 'COMMON.CHAIN'
4402 include 'COMMON.NAMES'
4403 include 'COMMON.IOUNITS'
4404 include 'COMMON.FFIELD'
4405 include 'COMMON.CONTROL'
4407 C Set lprn=.true. for debugging
4410 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4412 do i=itau_start,itau_end
4414 isccori=isccortyp(itype(i-2))
4415 isccori1=isccortyp(itype(i-1))
4417 cccc Added 9 May 2012
4418 cc Tauangle is torsional engle depending on the value of first digit
4419 c(see comment below)
4420 cc Omicron is flat angle depending on the value of first digit
4421 c(see comment below)
4424 do intertyp=1,3 !intertyp
4425 cc Added 09 May 2012 (Adasko)
4426 cc Intertyp means interaction type of backbone mainchain correlation:
4427 c 1 = SC...Ca...Ca...Ca
4428 c 2 = Ca...Ca...Ca...SC
4429 c 3 = SC...Ca...Ca...SCi
4431 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4432 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4433 & (itype(i-1).eq.21)))
4434 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4435 & .or.(itype(i-2).eq.21)))
4436 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4437 & (itype(i-1).eq.21)))) cycle
4438 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4439 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4441 do j=1,nterm_sccor(isccori,isccori1)
4442 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4443 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4444 cosphi=dcos(j*tauangle(intertyp,i))
4445 sinphi=dsin(j*tauangle(intertyp,i))
4446 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4447 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4449 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4450 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4451 c &gloc_sc(intertyp,i-3,icg)
4453 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4454 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4455 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4456 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4457 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4463 c------------------------------------------------------------------------------
4464 subroutine multibody(ecorr)
4465 C This subroutine calculates multi-body contributions to energy following
4466 C the idea of Skolnick et al. If side chains I and J make a contact and
4467 C at the same time side chains I+1 and J+1 make a contact, an extra
4468 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4469 implicit real*8 (a-h,o-z)
4470 include 'DIMENSIONS'
4471 include 'COMMON.IOUNITS'
4472 include 'COMMON.DERIV'
4473 include 'COMMON.INTERACT'
4474 include 'COMMON.CONTACTS'
4475 double precision gx(3),gx1(3)
4478 C Set lprn=.true. for debugging
4482 write (iout,'(a)') 'Contact function values:'
4484 write (iout,'(i2,20(1x,i2,f10.5))')
4485 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4500 num_conti=num_cont(i)
4501 num_conti1=num_cont(i1)
4506 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4507 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4508 cd & ' ishift=',ishift
4509 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4510 C The system gains extra energy.
4511 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4512 endif ! j1==j+-ishift
4521 c------------------------------------------------------------------------------
4522 double precision function esccorr(i,j,k,l,jj,kk)
4523 implicit real*8 (a-h,o-z)
4524 include 'DIMENSIONS'
4525 include 'COMMON.IOUNITS'
4526 include 'COMMON.DERIV'
4527 include 'COMMON.INTERACT'
4528 include 'COMMON.CONTACTS'
4529 double precision gx(3),gx1(3)
4534 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4535 C Calculate the multi-body contribution to energy.
4536 C Calculate multi-body contributions to the gradient.
4537 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4538 cd & k,l,(gacont(m,kk,k),m=1,3)
4540 gx(m) =ekl*gacont(m,jj,i)
4541 gx1(m)=eij*gacont(m,kk,k)
4542 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4543 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4544 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4545 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4549 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4554 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4560 c------------------------------------------------------------------------------
4562 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4563 implicit real*8 (a-h,o-z)
4564 include 'DIMENSIONS'
4565 integer dimen1,dimen2,atom,indx
4566 double precision buffer(dimen1,dimen2)
4567 double precision zapas
4568 common /contacts_hb/ zapas(3,20,maxres,7),
4569 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4570 & num_cont_hb(maxres),jcont_hb(20,maxres)
4571 num_kont=num_cont_hb(atom)
4575 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4578 buffer(i,indx+22)=facont_hb(i,atom)
4579 buffer(i,indx+23)=ees0p(i,atom)
4580 buffer(i,indx+24)=ees0m(i,atom)
4581 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4583 buffer(1,indx+26)=dfloat(num_kont)
4586 c------------------------------------------------------------------------------
4587 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4588 implicit real*8 (a-h,o-z)
4589 include 'DIMENSIONS'
4590 integer dimen1,dimen2,atom,indx
4591 double precision buffer(dimen1,dimen2)
4592 double precision zapas
4593 common /contacts_hb/ zapas(3,20,maxres,7),
4594 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4595 & num_cont_hb(maxres),jcont_hb(20,maxres)
4596 num_kont=buffer(1,indx+26)
4597 num_kont_old=num_cont_hb(atom)
4598 num_cont_hb(atom)=num_kont+num_kont_old
4603 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4606 facont_hb(ii,atom)=buffer(i,indx+22)
4607 ees0p(ii,atom)=buffer(i,indx+23)
4608 ees0m(ii,atom)=buffer(i,indx+24)
4609 jcont_hb(ii,atom)=buffer(i,indx+25)
4613 c------------------------------------------------------------------------------
4615 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4616 C This subroutine calculates multi-body contributions to hydrogen-bonding
4617 implicit real*8 (a-h,o-z)
4618 include 'DIMENSIONS'
4619 include 'sizesclu.dat'
4620 include 'COMMON.IOUNITS'
4622 include 'COMMON.INFO'
4624 include 'COMMON.FFIELD'
4625 include 'COMMON.DERIV'
4626 include 'COMMON.INTERACT'
4627 include 'COMMON.CONTACTS'
4629 parameter (max_cont=maxconts)
4630 parameter (max_dim=2*(8*3+2))
4631 parameter (msglen1=max_cont*max_dim*4)
4632 parameter (msglen2=2*msglen1)
4633 integer source,CorrelType,CorrelID,Error
4634 double precision buffer(max_cont,max_dim)
4636 double precision gx(3),gx1(3)
4639 C Set lprn=.true. for debugging
4644 if (fgProcs.le.1) goto 30
4646 write (iout,'(a)') 'Contact function values:'
4648 write (iout,'(2i3,50(1x,i2,f5.2))')
4649 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4650 & j=1,num_cont_hb(i))
4653 C Caution! Following code assumes that electrostatic interactions concerning
4654 C a given atom are split among at most two processors!
4664 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4667 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4668 if (MyRank.gt.0) then
4669 C Send correlation contributions to the preceding processor
4671 nn=num_cont_hb(iatel_s)
4672 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4673 cd write (iout,*) 'The BUFFER array:'
4675 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4677 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4679 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4680 C Clear the contacts of the atom passed to the neighboring processor
4681 nn=num_cont_hb(iatel_s+1)
4683 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4685 num_cont_hb(iatel_s)=0
4687 cd write (iout,*) 'Processor ',MyID,MyRank,
4688 cd & ' is sending correlation contribution to processor',MyID-1,
4689 cd & ' msglen=',msglen
4690 cd write (*,*) 'Processor ',MyID,MyRank,
4691 cd & ' is sending correlation contribution to processor',MyID-1,
4692 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4693 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4694 cd write (iout,*) 'Processor ',MyID,
4695 cd & ' has sent correlation contribution to processor',MyID-1,
4696 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4697 cd write (*,*) 'Processor ',MyID,
4698 cd & ' has sent correlation contribution to processor',MyID-1,
4699 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4701 endif ! (MyRank.gt.0)
4705 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4706 if (MyRank.lt.fgProcs-1) then
4707 C Receive correlation contributions from the next processor
4709 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4710 cd write (iout,*) 'Processor',MyID,
4711 cd & ' is receiving correlation contribution from processor',MyID+1,
4712 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4713 cd write (*,*) 'Processor',MyID,
4714 cd & ' is receiving correlation contribution from processor',MyID+1,
4715 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4717 do while (nbytes.le.0)
4718 call mp_probe(MyID+1,CorrelType,nbytes)
4720 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4721 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4722 cd write (iout,*) 'Processor',MyID,
4723 cd & ' has received correlation contribution from processor',MyID+1,
4724 cd & ' msglen=',msglen,' nbytes=',nbytes
4725 cd write (iout,*) 'The received BUFFER array:'
4727 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4729 if (msglen.eq.msglen1) then
4730 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4731 else if (msglen.eq.msglen2) then
4732 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4733 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4736 & 'ERROR!!!! message length changed while processing correlations.'
4738 & 'ERROR!!!! message length changed while processing correlations.'
4739 call mp_stopall(Error)
4740 endif ! msglen.eq.msglen1
4741 endif ! MyRank.lt.fgProcs-1
4748 write (iout,'(a)') 'Contact function values:'
4750 write (iout,'(2i3,50(1x,i2,f5.2))')
4751 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4752 & j=1,num_cont_hb(i))
4756 C Remove the loop below after debugging !!!
4763 C Calculate the local-electrostatic correlation terms
4764 do i=iatel_s,iatel_e+1
4766 num_conti=num_cont_hb(i)
4767 num_conti1=num_cont_hb(i+1)
4772 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4773 c & ' jj=',jj,' kk=',kk
4774 if (j1.eq.j+1 .or. j1.eq.j-1) then
4775 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4776 C The system gains extra energy.
4777 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4779 else if (j1.eq.j) then
4780 C Contacts I-J and I-(J+1) occur simultaneously.
4781 C The system loses extra energy.
4782 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4787 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4788 c & ' jj=',jj,' kk=',kk
4790 C Contacts I-J and (I+1)-J occur simultaneously.
4791 C The system loses extra energy.
4792 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4799 c------------------------------------------------------------------------------
4800 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4802 C This subroutine calculates multi-body contributions to hydrogen-bonding
4803 implicit real*8 (a-h,o-z)
4804 include 'DIMENSIONS'
4805 include 'sizesclu.dat'
4806 include 'COMMON.IOUNITS'
4808 include 'COMMON.INFO'
4810 include 'COMMON.FFIELD'
4811 include 'COMMON.DERIV'
4812 include 'COMMON.INTERACT'
4813 include 'COMMON.CONTACTS'
4815 parameter (max_cont=maxconts)
4816 parameter (max_dim=2*(8*3+2))
4817 parameter (msglen1=max_cont*max_dim*4)
4818 parameter (msglen2=2*msglen1)
4819 integer source,CorrelType,CorrelID,Error
4820 double precision buffer(max_cont,max_dim)
4822 double precision gx(3),gx1(3)
4825 C Set lprn=.true. for debugging
4831 if (fgProcs.le.1) goto 30
4833 write (iout,'(a)') 'Contact function values:'
4835 write (iout,'(2i3,50(1x,i2,f5.2))')
4836 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4837 & j=1,num_cont_hb(i))
4840 C Caution! Following code assumes that electrostatic interactions concerning
4841 C a given atom are split among at most two processors!
4851 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4854 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4855 if (MyRank.gt.0) then
4856 C Send correlation contributions to the preceding processor
4858 nn=num_cont_hb(iatel_s)
4859 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4860 cd write (iout,*) 'The BUFFER array:'
4862 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4864 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4866 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4867 C Clear the contacts of the atom passed to the neighboring processor
4868 nn=num_cont_hb(iatel_s+1)
4870 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4872 num_cont_hb(iatel_s)=0
4874 cd write (iout,*) 'Processor ',MyID,MyRank,
4875 cd & ' is sending correlation contribution to processor',MyID-1,
4876 cd & ' msglen=',msglen
4877 cd write (*,*) 'Processor ',MyID,MyRank,
4878 cd & ' is sending correlation contribution to processor',MyID-1,
4879 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4880 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4881 cd write (iout,*) 'Processor ',MyID,
4882 cd & ' has sent correlation contribution to processor',MyID-1,
4883 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4884 cd write (*,*) 'Processor ',MyID,
4885 cd & ' has sent correlation contribution to processor',MyID-1,
4886 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4888 endif ! (MyRank.gt.0)
4892 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4893 if (MyRank.lt.fgProcs-1) then
4894 C Receive correlation contributions from the next processor
4896 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4897 cd write (iout,*) 'Processor',MyID,
4898 cd & ' is receiving correlation contribution from processor',MyID+1,
4899 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4900 cd write (*,*) 'Processor',MyID,
4901 cd & ' is receiving correlation contribution from processor',MyID+1,
4902 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4904 do while (nbytes.le.0)
4905 call mp_probe(MyID+1,CorrelType,nbytes)
4907 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4908 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4909 cd write (iout,*) 'Processor',MyID,
4910 cd & ' has received correlation contribution from processor',MyID+1,
4911 cd & ' msglen=',msglen,' nbytes=',nbytes
4912 cd write (iout,*) 'The received BUFFER array:'
4914 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4916 if (msglen.eq.msglen1) then
4917 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4918 else if (msglen.eq.msglen2) then
4919 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4920 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4923 & 'ERROR!!!! message length changed while processing correlations.'
4925 & 'ERROR!!!! message length changed while processing correlations.'
4926 call mp_stopall(Error)
4927 endif ! msglen.eq.msglen1
4928 endif ! MyRank.lt.fgProcs-1
4935 write (iout,'(a)') 'Contact function values:'
4937 write (iout,'(2i3,50(1x,i2,f5.2))')
4938 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4939 & j=1,num_cont_hb(i))
4945 C Remove the loop below after debugging !!!
4952 C Calculate the dipole-dipole interaction energies
4953 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
4954 do i=iatel_s,iatel_e+1
4955 num_conti=num_cont_hb(i)
4962 C Calculate the local-electrostatic correlation terms
4963 do i=iatel_s,iatel_e+1
4965 num_conti=num_cont_hb(i)
4966 num_conti1=num_cont_hb(i+1)
4971 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4972 c & ' jj=',jj,' kk=',kk
4973 if (j1.eq.j+1 .or. j1.eq.j-1) then
4974 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4975 C The system gains extra energy.
4977 sqd1=dsqrt(d_cont(jj,i))
4978 sqd2=dsqrt(d_cont(kk,i1))
4979 sred_geom = sqd1*sqd2
4980 IF (sred_geom.lt.cutoff_corr) THEN
4981 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
4983 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4984 c & ' jj=',jj,' kk=',kk
4985 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
4986 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
4988 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
4989 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
4992 cd write (iout,*) 'sred_geom=',sred_geom,
4993 cd & ' ekont=',ekont,' fprim=',fprimcont
4994 call calc_eello(i,j,i+1,j1,jj,kk)
4995 if (wcorr4.gt.0.0d0)
4996 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
4997 if (wcorr5.gt.0.0d0)
4998 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
4999 c print *,"wcorr5",ecorr5
5000 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5001 cd write(2,*)'ijkl',i,j,i+1,j1
5002 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5003 & .or. wturn6.eq.0.0d0))then
5004 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5005 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5006 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5007 cd & 'ecorr6=',ecorr6
5008 cd write (iout,'(4e15.5)') sred_geom,
5009 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5010 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5011 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5012 else if (wturn6.gt.0.0d0
5013 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5014 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5015 eturn6=eturn6+eello_turn6(i,jj,kk)
5016 cd write (2,*) 'multibody_eello:eturn6',eturn6
5020 else if (j1.eq.j) then
5021 C Contacts I-J and I-(J+1) occur simultaneously.
5022 C The system loses extra energy.
5023 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5028 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5029 c & ' jj=',jj,' kk=',kk
5031 C Contacts I-J and (I+1)-J occur simultaneously.
5032 C The system loses extra energy.
5033 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5040 c------------------------------------------------------------------------------
5041 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5042 implicit real*8 (a-h,o-z)
5043 include 'DIMENSIONS'
5044 include 'COMMON.IOUNITS'
5045 include 'COMMON.DERIV'
5046 include 'COMMON.INTERACT'
5047 include 'COMMON.CONTACTS'
5048 double precision gx(3),gx1(3)
5058 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5059 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5060 C Following 4 lines for diagnostics.
5065 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5067 c write (iout,*)'Contacts have occurred for peptide groups',
5068 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5069 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5070 C Calculate the multi-body contribution to energy.
5071 ecorr=ecorr+ekont*ees
5073 C Calculate multi-body contributions to the gradient.
5075 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5076 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5077 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5078 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5079 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5080 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5081 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5082 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5083 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5084 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5085 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5086 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5087 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5088 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5092 gradcorr(ll,m)=gradcorr(ll,m)+
5093 & ees*ekl*gacont_hbr(ll,jj,i)-
5094 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5095 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5100 gradcorr(ll,m)=gradcorr(ll,m)+
5101 & ees*eij*gacont_hbr(ll,kk,k)-
5102 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5103 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5110 C---------------------------------------------------------------------------
5111 subroutine dipole(i,j,jj)
5112 implicit real*8 (a-h,o-z)
5113 include 'DIMENSIONS'
5114 include 'sizesclu.dat'
5115 include 'COMMON.IOUNITS'
5116 include 'COMMON.CHAIN'
5117 include 'COMMON.FFIELD'
5118 include 'COMMON.DERIV'
5119 include 'COMMON.INTERACT'
5120 include 'COMMON.CONTACTS'
5121 include 'COMMON.TORSION'
5122 include 'COMMON.VAR'
5123 include 'COMMON.GEO'
5124 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5126 iti1 = itortyp(itype(i+1))
5127 if (j.lt.nres-1) then
5128 itj1 = itortyp(itype(j+1))
5133 dipi(iii,1)=Ub2(iii,i)
5134 dipderi(iii)=Ub2der(iii,i)
5135 dipi(iii,2)=b1(iii,iti1)
5136 dipj(iii,1)=Ub2(iii,j)
5137 dipderj(iii)=Ub2der(iii,j)
5138 dipj(iii,2)=b1(iii,itj1)
5142 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5145 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5148 if (.not.calc_grad) return
5153 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5157 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5162 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5163 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5165 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5167 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5169 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5173 C---------------------------------------------------------------------------
5174 subroutine calc_eello(i,j,k,l,jj,kk)
5176 C This subroutine computes matrices and vectors needed to calculate
5177 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5179 implicit real*8 (a-h,o-z)
5180 include 'DIMENSIONS'
5181 include 'sizesclu.dat'
5182 include 'COMMON.IOUNITS'
5183 include 'COMMON.CHAIN'
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 include 'COMMON.FFIELD'
5191 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5192 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5195 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5196 cd & ' jj=',jj,' kk=',kk
5197 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5200 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5201 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5204 call transpose2(aa1(1,1),aa1t(1,1))
5205 call transpose2(aa2(1,1),aa2t(1,1))
5208 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5209 & aa1tder(1,1,lll,kkk))
5210 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5211 & aa2tder(1,1,lll,kkk))
5215 C parallel orientation of the two CA-CA-CA frames.
5217 iti=itortyp(itype(i))
5221 itk1=itortyp(itype(k+1))
5222 itj=itortyp(itype(j))
5223 if (l.lt.nres-1) then
5224 itl1=itortyp(itype(l+1))
5228 C A1 kernel(j+1) A2T
5230 cd write (iout,'(3f10.5,5x,3f10.5)')
5231 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5233 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5234 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5235 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5236 C Following matrices are needed only for 6-th order cumulants
5237 IF (wcorr6.gt.0.0d0) THEN
5238 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5239 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5240 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5241 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5242 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5243 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5244 & ADtEAderx(1,1,1,1,1,1))
5246 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5247 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5248 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5249 & ADtEA1derx(1,1,1,1,1,1))
5251 C End 6-th order cumulants
5254 cd write (2,*) 'In calc_eello6'
5256 cd write (2,*) 'iii=',iii
5258 cd write (2,*) 'kkk=',kkk
5260 cd write (2,'(3(2f10.5),5x)')
5261 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5266 call transpose2(EUgder(1,1,k),auxmat(1,1))
5267 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5268 call transpose2(EUg(1,1,k),auxmat(1,1))
5269 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5270 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5274 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5275 & EAEAderx(1,1,lll,kkk,iii,1))
5279 C A1T kernel(i+1) A2
5280 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5281 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5282 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5283 C Following matrices are needed only for 6-th order cumulants
5284 IF (wcorr6.gt.0.0d0) THEN
5285 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5286 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5287 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5288 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5289 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5290 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5291 & ADtEAderx(1,1,1,1,1,2))
5292 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5293 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5294 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5295 & ADtEA1derx(1,1,1,1,1,2))
5297 C End 6-th order cumulants
5298 call transpose2(EUgder(1,1,l),auxmat(1,1))
5299 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5300 call transpose2(EUg(1,1,l),auxmat(1,1))
5301 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5302 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5306 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5307 & EAEAderx(1,1,lll,kkk,iii,2))
5312 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5313 C They are needed only when the fifth- or the sixth-order cumulants are
5315 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5316 call transpose2(AEA(1,1,1),auxmat(1,1))
5317 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5318 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5319 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5320 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5321 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5322 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5323 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5324 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5325 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5326 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5327 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5328 call transpose2(AEA(1,1,2),auxmat(1,1))
5329 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5330 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5331 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5332 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5333 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5334 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5335 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5336 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5337 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5338 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5339 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5340 C Calculate the Cartesian derivatives of the vectors.
5344 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5345 call matvec2(auxmat(1,1),b1(1,iti),
5346 & AEAb1derx(1,lll,kkk,iii,1,1))
5347 call matvec2(auxmat(1,1),Ub2(1,i),
5348 & AEAb2derx(1,lll,kkk,iii,1,1))
5349 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5350 & AEAb1derx(1,lll,kkk,iii,2,1))
5351 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5352 & AEAb2derx(1,lll,kkk,iii,2,1))
5353 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5354 call matvec2(auxmat(1,1),b1(1,itj),
5355 & AEAb1derx(1,lll,kkk,iii,1,2))
5356 call matvec2(auxmat(1,1),Ub2(1,j),
5357 & AEAb2derx(1,lll,kkk,iii,1,2))
5358 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5359 & AEAb1derx(1,lll,kkk,iii,2,2))
5360 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5361 & AEAb2derx(1,lll,kkk,iii,2,2))
5368 C Antiparallel orientation of the two CA-CA-CA frames.
5370 iti=itortyp(itype(i))
5374 itk1=itortyp(itype(k+1))
5375 itl=itortyp(itype(l))
5376 itj=itortyp(itype(j))
5377 if (j.lt.nres-1) then
5378 itj1=itortyp(itype(j+1))
5382 C A2 kernel(j-1)T A1T
5383 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5384 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5385 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5386 C Following matrices are needed only for 6-th order cumulants
5387 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5388 & j.eq.i+4 .and. l.eq.i+3)) THEN
5389 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5390 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5391 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5392 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5393 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5394 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5395 & ADtEAderx(1,1,1,1,1,1))
5396 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5397 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5398 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5399 & ADtEA1derx(1,1,1,1,1,1))
5401 C End 6-th order cumulants
5402 call transpose2(EUgder(1,1,k),auxmat(1,1))
5403 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5404 call transpose2(EUg(1,1,k),auxmat(1,1))
5405 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5406 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5410 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5411 & EAEAderx(1,1,lll,kkk,iii,1))
5415 C A2T kernel(i+1)T A1
5416 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5417 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5418 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5419 C Following matrices are needed only for 6-th order cumulants
5420 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5421 & j.eq.i+4 .and. l.eq.i+3)) THEN
5422 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5423 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5424 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5425 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5426 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5427 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5428 & ADtEAderx(1,1,1,1,1,2))
5429 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5430 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5431 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5432 & ADtEA1derx(1,1,1,1,1,2))
5434 C End 6-th order cumulants
5435 call transpose2(EUgder(1,1,j),auxmat(1,1))
5436 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5437 call transpose2(EUg(1,1,j),auxmat(1,1))
5438 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5439 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5443 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5444 & EAEAderx(1,1,lll,kkk,iii,2))
5449 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5450 C They are needed only when the fifth- or the sixth-order cumulants are
5452 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5453 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5454 call transpose2(AEA(1,1,1),auxmat(1,1))
5455 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5456 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5457 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5458 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5459 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5460 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5461 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5462 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5463 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5464 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5465 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5466 call transpose2(AEA(1,1,2),auxmat(1,1))
5467 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5468 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5469 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5470 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5471 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5472 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5473 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5474 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5475 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5476 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5477 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5478 C Calculate the Cartesian derivatives of the vectors.
5482 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5483 call matvec2(auxmat(1,1),b1(1,iti),
5484 & AEAb1derx(1,lll,kkk,iii,1,1))
5485 call matvec2(auxmat(1,1),Ub2(1,i),
5486 & AEAb2derx(1,lll,kkk,iii,1,1))
5487 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5488 & AEAb1derx(1,lll,kkk,iii,2,1))
5489 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5490 & AEAb2derx(1,lll,kkk,iii,2,1))
5491 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5492 call matvec2(auxmat(1,1),b1(1,itl),
5493 & AEAb1derx(1,lll,kkk,iii,1,2))
5494 call matvec2(auxmat(1,1),Ub2(1,l),
5495 & AEAb2derx(1,lll,kkk,iii,1,2))
5496 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5497 & AEAb1derx(1,lll,kkk,iii,2,2))
5498 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5499 & AEAb2derx(1,lll,kkk,iii,2,2))
5508 C---------------------------------------------------------------------------
5509 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5510 & KK,KKderg,AKA,AKAderg,AKAderx)
5514 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5515 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5516 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5521 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5523 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5526 cd if (lprn) write (2,*) 'In kernel'
5528 cd if (lprn) write (2,*) 'kkk=',kkk
5530 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5531 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5533 cd write (2,*) 'lll=',lll
5534 cd write (2,*) 'iii=1'
5536 cd write (2,'(3(2f10.5),5x)')
5537 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5540 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5541 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5543 cd write (2,*) 'lll=',lll
5544 cd write (2,*) 'iii=2'
5546 cd write (2,'(3(2f10.5),5x)')
5547 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5554 C---------------------------------------------------------------------------
5555 double precision function eello4(i,j,k,l,jj,kk)
5556 implicit real*8 (a-h,o-z)
5557 include 'DIMENSIONS'
5558 include 'sizesclu.dat'
5559 include 'COMMON.IOUNITS'
5560 include 'COMMON.CHAIN'
5561 include 'COMMON.DERIV'
5562 include 'COMMON.INTERACT'
5563 include 'COMMON.CONTACTS'
5564 include 'COMMON.TORSION'
5565 include 'COMMON.VAR'
5566 include 'COMMON.GEO'
5567 double precision pizda(2,2),ggg1(3),ggg2(3)
5568 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5572 cd print *,'eello4:',i,j,k,l,jj,kk
5573 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5574 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5575 cold eij=facont_hb(jj,i)
5576 cold ekl=facont_hb(kk,k)
5578 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5580 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5581 gcorr_loc(k-1)=gcorr_loc(k-1)
5582 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5584 gcorr_loc(l-1)=gcorr_loc(l-1)
5585 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5587 gcorr_loc(j-1)=gcorr_loc(j-1)
5588 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5593 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5594 & -EAEAderx(2,2,lll,kkk,iii,1)
5595 cd derx(lll,kkk,iii)=0.0d0
5599 cd gcorr_loc(l-1)=0.0d0
5600 cd gcorr_loc(j-1)=0.0d0
5601 cd gcorr_loc(k-1)=0.0d0
5603 cd write (iout,*)'Contacts have occurred for peptide groups',
5604 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5605 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5606 if (j.lt.nres-1) then
5613 if (l.lt.nres-1) then
5621 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5622 ggg1(ll)=eel4*g_contij(ll,1)
5623 ggg2(ll)=eel4*g_contij(ll,2)
5624 ghalf=0.5d0*ggg1(ll)
5626 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5627 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5628 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5629 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5630 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5631 ghalf=0.5d0*ggg2(ll)
5633 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5634 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5635 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5636 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5641 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5642 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5647 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5648 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5654 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5659 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5663 cd write (2,*) iii,gcorr_loc(iii)
5667 cd write (2,*) 'ekont',ekont
5668 cd write (iout,*) 'eello4',ekont*eel4
5671 C---------------------------------------------------------------------------
5672 double precision function eello5(i,j,k,l,jj,kk)
5673 implicit real*8 (a-h,o-z)
5674 include 'DIMENSIONS'
5675 include 'sizesclu.dat'
5676 include 'COMMON.IOUNITS'
5677 include 'COMMON.CHAIN'
5678 include 'COMMON.DERIV'
5679 include 'COMMON.INTERACT'
5680 include 'COMMON.CONTACTS'
5681 include 'COMMON.TORSION'
5682 include 'COMMON.VAR'
5683 include 'COMMON.GEO'
5684 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5685 double precision ggg1(3),ggg2(3)
5686 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5691 C /l\ / \ \ / \ / \ / C
5692 C / \ / \ \ / \ / \ / C
5693 C j| o |l1 | o | o| o | | o |o C
5694 C \ |/k\| |/ \| / |/ \| |/ \| C
5695 C \i/ \ / \ / / \ / \ C
5697 C (I) (II) (III) (IV) C
5699 C eello5_1 eello5_2 eello5_3 eello5_4 C
5701 C Antiparallel chains C
5704 C /j\ / \ \ / \ / \ / C
5705 C / \ / \ \ / \ / \ / C
5706 C j1| o |l | o | o| o | | o |o C
5707 C \ |/k\| |/ \| / |/ \| |/ \| C
5708 C \i/ \ / \ / / \ / \ C
5710 C (I) (II) (III) (IV) C
5712 C eello5_1 eello5_2 eello5_3 eello5_4 C
5714 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5716 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5717 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5722 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5724 itk=itortyp(itype(k))
5725 itl=itortyp(itype(l))
5726 itj=itortyp(itype(j))
5731 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5732 cd & eel5_3_num,eel5_4_num)
5736 derx(lll,kkk,iii)=0.0d0
5740 cd eij=facont_hb(jj,i)
5741 cd ekl=facont_hb(kk,k)
5743 cd write (iout,*)'Contacts have occurred for peptide groups',
5744 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5746 C Contribution from the graph I.
5747 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5748 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5749 call transpose2(EUg(1,1,k),auxmat(1,1))
5750 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5751 vv(1)=pizda(1,1)-pizda(2,2)
5752 vv(2)=pizda(1,2)+pizda(2,1)
5753 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5754 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5756 C Explicit gradient in virtual-dihedral angles.
5757 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5758 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5759 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5760 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5761 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5762 vv(1)=pizda(1,1)-pizda(2,2)
5763 vv(2)=pizda(1,2)+pizda(2,1)
5764 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5765 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5766 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5767 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5768 vv(1)=pizda(1,1)-pizda(2,2)
5769 vv(2)=pizda(1,2)+pizda(2,1)
5771 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5772 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5773 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5775 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5776 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5777 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5779 C Cartesian gradient
5783 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5785 vv(1)=pizda(1,1)-pizda(2,2)
5786 vv(2)=pizda(1,2)+pizda(2,1)
5787 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5788 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5789 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5796 C Contribution from graph II
5797 call transpose2(EE(1,1,itk),auxmat(1,1))
5798 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5799 vv(1)=pizda(1,1)+pizda(2,2)
5800 vv(2)=pizda(2,1)-pizda(1,2)
5801 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5802 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5804 C Explicit gradient in virtual-dihedral angles.
5805 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5806 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5807 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5808 vv(1)=pizda(1,1)+pizda(2,2)
5809 vv(2)=pizda(2,1)-pizda(1,2)
5811 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5812 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5813 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5815 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5816 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5817 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5819 C Cartesian gradient
5823 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5825 vv(1)=pizda(1,1)+pizda(2,2)
5826 vv(2)=pizda(2,1)-pizda(1,2)
5827 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5828 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5829 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5838 C Parallel orientation
5839 C Contribution from graph III
5840 call transpose2(EUg(1,1,l),auxmat(1,1))
5841 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5842 vv(1)=pizda(1,1)-pizda(2,2)
5843 vv(2)=pizda(1,2)+pizda(2,1)
5844 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5845 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5847 C Explicit gradient in virtual-dihedral angles.
5848 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5849 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5850 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5851 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5852 vv(1)=pizda(1,1)-pizda(2,2)
5853 vv(2)=pizda(1,2)+pizda(2,1)
5854 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5855 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5856 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5857 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5858 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5859 vv(1)=pizda(1,1)-pizda(2,2)
5860 vv(2)=pizda(1,2)+pizda(2,1)
5861 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5862 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5863 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5864 C Cartesian gradient
5868 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5870 vv(1)=pizda(1,1)-pizda(2,2)
5871 vv(2)=pizda(1,2)+pizda(2,1)
5872 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5873 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5874 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5880 C Contribution from graph IV
5882 call transpose2(EE(1,1,itl),auxmat(1,1))
5883 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5884 vv(1)=pizda(1,1)+pizda(2,2)
5885 vv(2)=pizda(2,1)-pizda(1,2)
5886 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5887 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5889 C Explicit gradient in virtual-dihedral angles.
5890 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5891 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5892 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5893 vv(1)=pizda(1,1)+pizda(2,2)
5894 vv(2)=pizda(2,1)-pizda(1,2)
5895 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5896 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5897 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5898 C Cartesian gradient
5902 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5904 vv(1)=pizda(1,1)+pizda(2,2)
5905 vv(2)=pizda(2,1)-pizda(1,2)
5906 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5907 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5908 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5914 C Antiparallel orientation
5915 C Contribution from graph III
5917 call transpose2(EUg(1,1,j),auxmat(1,1))
5918 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5919 vv(1)=pizda(1,1)-pizda(2,2)
5920 vv(2)=pizda(1,2)+pizda(2,1)
5921 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
5922 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5924 C Explicit gradient in virtual-dihedral angles.
5925 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5926 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
5927 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
5928 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5929 vv(1)=pizda(1,1)-pizda(2,2)
5930 vv(2)=pizda(1,2)+pizda(2,1)
5931 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5932 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
5933 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
5934 call transpose2(EUgder(1,1,j),auxmat1(1,1))
5935 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5936 vv(1)=pizda(1,1)-pizda(2,2)
5937 vv(2)=pizda(1,2)+pizda(2,1)
5938 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5939 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
5940 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
5941 C Cartesian gradient
5945 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5947 vv(1)=pizda(1,1)-pizda(2,2)
5948 vv(2)=pizda(1,2)+pizda(2,1)
5949 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
5950 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
5951 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5957 C Contribution from graph IV
5959 call transpose2(EE(1,1,itj),auxmat(1,1))
5960 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5961 vv(1)=pizda(1,1)+pizda(2,2)
5962 vv(2)=pizda(2,1)-pizda(1,2)
5963 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
5964 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
5966 C Explicit gradient in virtual-dihedral angles.
5967 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5968 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
5969 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5970 vv(1)=pizda(1,1)+pizda(2,2)
5971 vv(2)=pizda(2,1)-pizda(1,2)
5972 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5973 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
5974 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
5975 C Cartesian gradient
5979 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5981 vv(1)=pizda(1,1)+pizda(2,2)
5982 vv(2)=pizda(2,1)-pizda(1,2)
5983 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
5984 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
5985 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
5992 eel5=eello5_1+eello5_2+eello5_3+eello5_4
5993 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
5994 cd write (2,*) 'ijkl',i,j,k,l
5995 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
5996 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
5998 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
5999 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6000 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6001 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6003 if (j.lt.nres-1) then
6010 if (l.lt.nres-1) then
6020 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6022 ggg1(ll)=eel5*g_contij(ll,1)
6023 ggg2(ll)=eel5*g_contij(ll,2)
6024 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6025 ghalf=0.5d0*ggg1(ll)
6027 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6028 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6029 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6030 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6031 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6032 ghalf=0.5d0*ggg2(ll)
6034 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6035 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6036 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6037 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6042 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6043 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6048 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6049 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6055 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6060 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6064 cd write (2,*) iii,g_corr5_loc(iii)
6068 cd write (2,*) 'ekont',ekont
6069 cd write (iout,*) 'eello5',ekont*eel5
6072 c--------------------------------------------------------------------------
6073 double precision function eello6(i,j,k,l,jj,kk)
6074 implicit real*8 (a-h,o-z)
6075 include 'DIMENSIONS'
6076 include 'sizesclu.dat'
6077 include 'COMMON.IOUNITS'
6078 include 'COMMON.CHAIN'
6079 include 'COMMON.DERIV'
6080 include 'COMMON.INTERACT'
6081 include 'COMMON.CONTACTS'
6082 include 'COMMON.TORSION'
6083 include 'COMMON.VAR'
6084 include 'COMMON.GEO'
6085 include 'COMMON.FFIELD'
6086 double precision ggg1(3),ggg2(3)
6087 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6092 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6100 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6101 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6105 derx(lll,kkk,iii)=0.0d0
6109 cd eij=facont_hb(jj,i)
6110 cd ekl=facont_hb(kk,k)
6116 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6117 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6118 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6119 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6120 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6121 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6123 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6124 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6125 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6126 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6127 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6128 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6132 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6134 C If turn contributions are considered, they will be handled separately.
6135 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6136 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6137 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6138 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6139 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6140 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6141 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6144 if (j.lt.nres-1) then
6151 if (l.lt.nres-1) then
6159 ggg1(ll)=eel6*g_contij(ll,1)
6160 ggg2(ll)=eel6*g_contij(ll,2)
6161 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6162 ghalf=0.5d0*ggg1(ll)
6164 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6165 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6166 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6167 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6168 ghalf=0.5d0*ggg2(ll)
6169 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6171 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6172 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6173 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6174 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6179 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6180 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6185 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6186 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6192 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6197 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6201 cd write (2,*) iii,g_corr6_loc(iii)
6205 cd write (2,*) 'ekont',ekont
6206 cd write (iout,*) 'eello6',ekont*eel6
6209 c--------------------------------------------------------------------------
6210 double precision function eello6_graph1(i,j,k,l,imat,swap)
6211 implicit real*8 (a-h,o-z)
6212 include 'DIMENSIONS'
6213 include 'sizesclu.dat'
6214 include 'COMMON.IOUNITS'
6215 include 'COMMON.CHAIN'
6216 include 'COMMON.DERIV'
6217 include 'COMMON.INTERACT'
6218 include 'COMMON.CONTACTS'
6219 include 'COMMON.TORSION'
6220 include 'COMMON.VAR'
6221 include 'COMMON.GEO'
6222 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6226 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6228 C Parallel Antiparallel
6234 C \ j|/k\| / \ |/k\|l /
6239 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6240 itk=itortyp(itype(k))
6241 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6242 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6243 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6244 call transpose2(EUgC(1,1,k),auxmat(1,1))
6245 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6246 vv1(1)=pizda1(1,1)-pizda1(2,2)
6247 vv1(2)=pizda1(1,2)+pizda1(2,1)
6248 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6249 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6250 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6251 s5=scalar2(vv(1),Dtobr2(1,i))
6252 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6253 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6254 if (.not. calc_grad) return
6255 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6256 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6257 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6258 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6259 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6260 & +scalar2(vv(1),Dtobr2der(1,i)))
6261 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6262 vv1(1)=pizda1(1,1)-pizda1(2,2)
6263 vv1(2)=pizda1(1,2)+pizda1(2,1)
6264 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6265 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6267 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6268 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6269 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6270 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6271 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6273 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6274 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6275 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6276 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6277 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6279 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6280 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6281 vv1(1)=pizda1(1,1)-pizda1(2,2)
6282 vv1(2)=pizda1(1,2)+pizda1(2,1)
6283 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6284 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6285 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6286 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6295 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6296 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6297 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6298 call transpose2(EUgC(1,1,k),auxmat(1,1))
6299 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6301 vv1(1)=pizda1(1,1)-pizda1(2,2)
6302 vv1(2)=pizda1(1,2)+pizda1(2,1)
6303 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6304 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6305 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6306 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6307 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6308 s5=scalar2(vv(1),Dtobr2(1,i))
6309 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6315 c----------------------------------------------------------------------------
6316 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6317 implicit real*8 (a-h,o-z)
6318 include 'DIMENSIONS'
6319 include 'sizesclu.dat'
6320 include 'COMMON.IOUNITS'
6321 include 'COMMON.CHAIN'
6322 include 'COMMON.DERIV'
6323 include 'COMMON.INTERACT'
6324 include 'COMMON.CONTACTS'
6325 include 'COMMON.TORSION'
6326 include 'COMMON.VAR'
6327 include 'COMMON.GEO'
6329 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6330 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6333 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6335 C Parallel Antiparallel
6346 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6347 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6348 C AL 7/4/01 s1 would occur in the sixth-order moment,
6349 C but not in a cluster cumulant
6351 s1=dip(1,jj,i)*dip(1,kk,k)
6353 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6354 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6355 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6356 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6357 call transpose2(EUg(1,1,k),auxmat(1,1))
6358 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6359 vv(1)=pizda(1,1)-pizda(2,2)
6360 vv(2)=pizda(1,2)+pizda(2,1)
6361 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6362 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6364 eello6_graph2=-(s1+s2+s3+s4)
6366 eello6_graph2=-(s2+s3+s4)
6369 if (.not. calc_grad) return
6370 C Derivatives in gamma(i-1)
6373 s1=dipderg(1,jj,i)*dip(1,kk,k)
6375 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6376 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6377 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6378 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6380 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6382 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6384 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6386 C Derivatives in gamma(k-1)
6388 s1=dip(1,jj,i)*dipderg(1,kk,k)
6390 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6391 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6392 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6393 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6394 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6395 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6396 vv(1)=pizda(1,1)-pizda(2,2)
6397 vv(2)=pizda(1,2)+pizda(2,1)
6398 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6400 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6402 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6404 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6405 C Derivatives in gamma(j-1) or gamma(l-1)
6408 s1=dipderg(3,jj,i)*dip(1,kk,k)
6410 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6411 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6412 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6413 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6414 vv(1)=pizda(1,1)-pizda(2,2)
6415 vv(2)=pizda(1,2)+pizda(2,1)
6416 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6419 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6421 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6424 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6425 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6427 C Derivatives in gamma(l-1) or gamma(j-1)
6430 s1=dip(1,jj,i)*dipderg(3,kk,k)
6432 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6433 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6434 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6435 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6436 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6437 vv(1)=pizda(1,1)-pizda(2,2)
6438 vv(2)=pizda(1,2)+pizda(2,1)
6439 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6442 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6444 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6447 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6448 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6450 C Cartesian derivatives.
6452 write (2,*) 'In eello6_graph2'
6454 write (2,*) 'iii=',iii
6456 write (2,*) 'kkk=',kkk
6458 write (2,'(3(2f10.5),5x)')
6459 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6469 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6471 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6474 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6476 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6477 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6479 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6480 call transpose2(EUg(1,1,k),auxmat(1,1))
6481 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6483 vv(1)=pizda(1,1)-pizda(2,2)
6484 vv(2)=pizda(1,2)+pizda(2,1)
6485 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6486 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6488 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6490 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6493 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6495 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6502 c----------------------------------------------------------------------------
6503 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6504 implicit real*8 (a-h,o-z)
6505 include 'DIMENSIONS'
6506 include 'sizesclu.dat'
6507 include 'COMMON.IOUNITS'
6508 include 'COMMON.CHAIN'
6509 include 'COMMON.DERIV'
6510 include 'COMMON.INTERACT'
6511 include 'COMMON.CONTACTS'
6512 include 'COMMON.TORSION'
6513 include 'COMMON.VAR'
6514 include 'COMMON.GEO'
6515 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6517 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6519 C Parallel Antiparallel
6530 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6532 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6533 C energy moment and not to the cluster cumulant.
6534 iti=itortyp(itype(i))
6535 if (j.lt.nres-1) then
6536 itj1=itortyp(itype(j+1))
6540 itk=itortyp(itype(k))
6541 itk1=itortyp(itype(k+1))
6542 if (l.lt.nres-1) then
6543 itl1=itortyp(itype(l+1))
6548 s1=dip(4,jj,i)*dip(4,kk,k)
6550 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6551 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6552 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6553 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6554 call transpose2(EE(1,1,itk),auxmat(1,1))
6555 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6556 vv(1)=pizda(1,1)+pizda(2,2)
6557 vv(2)=pizda(2,1)-pizda(1,2)
6558 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6559 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6561 eello6_graph3=-(s1+s2+s3+s4)
6563 eello6_graph3=-(s2+s3+s4)
6566 if (.not. calc_grad) return
6567 C Derivatives in gamma(k-1)
6568 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6569 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6570 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6571 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6572 C Derivatives in gamma(l-1)
6573 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6574 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6575 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6576 vv(1)=pizda(1,1)+pizda(2,2)
6577 vv(2)=pizda(2,1)-pizda(1,2)
6578 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6579 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6580 C Cartesian derivatives.
6586 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6588 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6591 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6593 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6594 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6596 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6597 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6599 vv(1)=pizda(1,1)+pizda(2,2)
6600 vv(2)=pizda(2,1)-pizda(1,2)
6601 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6603 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6605 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6608 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6610 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6612 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6618 c----------------------------------------------------------------------------
6619 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6620 implicit real*8 (a-h,o-z)
6621 include 'DIMENSIONS'
6622 include 'sizesclu.dat'
6623 include 'COMMON.IOUNITS'
6624 include 'COMMON.CHAIN'
6625 include 'COMMON.DERIV'
6626 include 'COMMON.INTERACT'
6627 include 'COMMON.CONTACTS'
6628 include 'COMMON.TORSION'
6629 include 'COMMON.VAR'
6630 include 'COMMON.GEO'
6631 include 'COMMON.FFIELD'
6632 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6633 & auxvec1(2),auxmat1(2,2)
6635 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6637 C Parallel Antiparallel
6648 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6650 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6651 C energy moment and not to the cluster cumulant.
6652 cd write (2,*) 'eello_graph4: wturn6',wturn6
6653 iti=itortyp(itype(i))
6654 itj=itortyp(itype(j))
6655 if (j.lt.nres-1) then
6656 itj1=itortyp(itype(j+1))
6660 itk=itortyp(itype(k))
6661 if (k.lt.nres-1) then
6662 itk1=itortyp(itype(k+1))
6666 itl=itortyp(itype(l))
6667 if (l.lt.nres-1) then
6668 itl1=itortyp(itype(l+1))
6672 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6673 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6674 cd & ' itl',itl,' itl1',itl1
6677 s1=dip(3,jj,i)*dip(3,kk,k)
6679 s1=dip(2,jj,j)*dip(2,kk,l)
6682 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6683 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6685 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6686 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6688 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6689 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6691 call transpose2(EUg(1,1,k),auxmat(1,1))
6692 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6693 vv(1)=pizda(1,1)-pizda(2,2)
6694 vv(2)=pizda(2,1)+pizda(1,2)
6695 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6696 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6698 eello6_graph4=-(s1+s2+s3+s4)
6700 eello6_graph4=-(s2+s3+s4)
6702 if (.not. calc_grad) return
6703 C Derivatives in gamma(i-1)
6707 s1=dipderg(2,jj,i)*dip(3,kk,k)
6709 s1=dipderg(4,jj,j)*dip(2,kk,l)
6712 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6714 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6715 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6717 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6718 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6720 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6721 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6722 cd write (2,*) 'turn6 derivatives'
6724 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6726 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6730 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6732 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6736 C Derivatives in gamma(k-1)
6739 s1=dip(3,jj,i)*dipderg(2,kk,k)
6741 s1=dip(2,jj,j)*dipderg(4,kk,l)
6744 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6745 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6747 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6748 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6750 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6751 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6753 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6754 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6755 vv(1)=pizda(1,1)-pizda(2,2)
6756 vv(2)=pizda(2,1)+pizda(1,2)
6757 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6758 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6760 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6762 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6766 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6768 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6771 C Derivatives in gamma(j-1) or gamma(l-1)
6772 if (l.eq.j+1 .and. l.gt.1) then
6773 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6774 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6775 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6776 vv(1)=pizda(1,1)-pizda(2,2)
6777 vv(2)=pizda(2,1)+pizda(1,2)
6778 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6779 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6780 else if (j.gt.1) then
6781 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6782 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6783 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6784 vv(1)=pizda(1,1)-pizda(2,2)
6785 vv(2)=pizda(2,1)+pizda(1,2)
6786 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6787 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6788 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6790 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6793 C Cartesian derivatives.
6800 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6802 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6806 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6808 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6812 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6814 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6816 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6817 & b1(1,itj1),auxvec(1))
6818 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6820 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6821 & b1(1,itl1),auxvec(1))
6822 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6824 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6826 vv(1)=pizda(1,1)-pizda(2,2)
6827 vv(2)=pizda(2,1)+pizda(1,2)
6828 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6830 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6832 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6835 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6838 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6841 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6843 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6845 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6849 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6851 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6854 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6856 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6864 c----------------------------------------------------------------------------
6865 double precision function eello_turn6(i,jj,kk)
6866 implicit real*8 (a-h,o-z)
6867 include 'DIMENSIONS'
6868 include 'sizesclu.dat'
6869 include 'COMMON.IOUNITS'
6870 include 'COMMON.CHAIN'
6871 include 'COMMON.DERIV'
6872 include 'COMMON.INTERACT'
6873 include 'COMMON.CONTACTS'
6874 include 'COMMON.TORSION'
6875 include 'COMMON.VAR'
6876 include 'COMMON.GEO'
6877 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6878 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6880 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6881 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6882 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6883 C the respective energy moment and not to the cluster cumulant.
6888 iti=itortyp(itype(i))
6889 itk=itortyp(itype(k))
6890 itk1=itortyp(itype(k+1))
6891 itl=itortyp(itype(l))
6892 itj=itortyp(itype(j))
6893 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6894 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6895 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6900 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6902 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6906 derx_turn(lll,kkk,iii)=0.0d0
6913 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6915 cd write (2,*) 'eello6_5',eello6_5
6917 call transpose2(AEA(1,1,1),auxmat(1,1))
6918 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
6919 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
6920 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
6924 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
6925 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
6926 s2 = scalar2(b1(1,itk),vtemp1(1))
6928 call transpose2(AEA(1,1,2),atemp(1,1))
6929 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
6930 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
6931 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
6935 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
6936 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
6937 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
6939 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
6940 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
6941 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
6942 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
6943 ss13 = scalar2(b1(1,itk),vtemp4(1))
6944 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
6948 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
6954 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
6956 C Derivatives in gamma(i+2)
6958 call transpose2(AEA(1,1,1),auxmatd(1,1))
6959 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
6960 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
6961 call transpose2(AEAderg(1,1,2),atempd(1,1))
6962 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
6963 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
6967 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
6968 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
6969 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
6975 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
6976 C Derivatives in gamma(i+3)
6978 call transpose2(AEA(1,1,1),auxmatd(1,1))
6979 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
6980 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
6981 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
6985 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
6986 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
6987 s2d = scalar2(b1(1,itk),vtemp1d(1))
6989 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
6990 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
6992 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
6994 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
6995 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
6996 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7006 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7007 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7009 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7010 & -0.5d0*ekont*(s2d+s12d)
7012 C Derivatives in gamma(i+4)
7013 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7014 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7015 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7017 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7018 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7019 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7029 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7031 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7033 C Derivatives in gamma(i+5)
7035 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7036 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7037 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7041 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7042 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7043 s2d = scalar2(b1(1,itk),vtemp1d(1))
7045 call transpose2(AEA(1,1,2),atempd(1,1))
7046 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7047 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7051 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7052 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7054 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7055 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7056 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7066 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7067 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7069 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7070 & -0.5d0*ekont*(s2d+s12d)
7072 C Cartesian derivatives
7077 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7078 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7079 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7083 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7084 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7086 s2d = scalar2(b1(1,itk),vtemp1d(1))
7088 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7089 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7090 s8d = -(atempd(1,1)+atempd(2,2))*
7091 & scalar2(cc(1,1,itl),vtemp2(1))
7095 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7097 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7098 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7105 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7108 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7112 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7113 & - 0.5d0*(s8d+s12d)
7115 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7124 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7126 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7127 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7128 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7129 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7130 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7132 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7133 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7134 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7138 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7139 cd & 16*eel_turn6_num
7141 if (j.lt.nres-1) then
7148 if (l.lt.nres-1) then
7156 ggg1(ll)=eel_turn6*g_contij(ll,1)
7157 ggg2(ll)=eel_turn6*g_contij(ll,2)
7158 ghalf=0.5d0*ggg1(ll)
7160 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7161 & +ekont*derx_turn(ll,2,1)
7162 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7163 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7164 & +ekont*derx_turn(ll,4,1)
7165 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7166 ghalf=0.5d0*ggg2(ll)
7168 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7169 & +ekont*derx_turn(ll,2,2)
7170 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7171 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7172 & +ekont*derx_turn(ll,4,2)
7173 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7178 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7183 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7189 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7194 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7198 cd write (2,*) iii,g_corr6_loc(iii)
7201 eello_turn6=ekont*eel_turn6
7202 cd write (2,*) 'ekont',ekont
7203 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7206 crc-------------------------------------------------
7207 SUBROUTINE MATVEC2(A1,V1,V2)
7208 implicit real*8 (a-h,o-z)
7209 include 'DIMENSIONS'
7210 DIMENSION A1(2,2),V1(2),V2(2)
7214 c 3 VI=VI+A1(I,K)*V1(K)
7218 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7219 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7224 C---------------------------------------
7225 SUBROUTINE MATMAT2(A1,A2,A3)
7226 implicit real*8 (a-h,o-z)
7227 include 'DIMENSIONS'
7228 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7229 c DIMENSION AI3(2,2)
7233 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7239 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7240 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7241 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7242 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7250 c-------------------------------------------------------------------------
7251 double precision function scalar2(u,v)
7253 double precision u(2),v(2)
7256 scalar2=u(1)*v(1)+u(2)*v(2)
7260 C-----------------------------------------------------------------------------
7262 subroutine transpose2(a,at)
7264 double precision a(2,2),at(2,2)
7271 c--------------------------------------------------------------------------
7272 subroutine transpose(n,a,at)
7275 double precision a(n,n),at(n,n)
7283 C---------------------------------------------------------------------------
7284 subroutine prodmat3(a1,a2,kk,transp,prod)
7287 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7289 crc double precision auxmat(2,2),prod_(2,2)
7292 crc call transpose2(kk(1,1),auxmat(1,1))
7293 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7294 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7296 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7297 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7298 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7299 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7300 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7301 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7302 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7303 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7306 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7307 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7309 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7310 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7311 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7312 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7313 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7314 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7315 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7316 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7319 c call transpose2(a2(1,1),a2t(1,1))
7322 crc print *,((prod_(i,j),i=1,2),j=1,2)
7323 crc print *,((prod(i,j),i=1,2),j=1,2)
7327 C-----------------------------------------------------------------------------
7328 double precision function scalar(u,v)
7330 double precision u(3),v(3)