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 'COMMON.SBRIDGE'
2798 include 'COMMON.CHAIN'
2799 include 'COMMON.DERIV'
2800 include 'COMMON.VAR'
2801 include 'COMMON.INTERACT'
2802 include 'COMMON.IOUNITS'
2805 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2806 cd write(iout,*)'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 write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2822 c & dhpb(i),dhpb1(i),forcon(i)
2823 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2824 C distance and angle dependent SS bond potential.
2825 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2826 call ssbond_ene(iii,jjj,eij)
2828 cd write (iout,*) "eij",eij
2829 else if (ii.gt.nres .and. jj.gt.nres) then
2830 c Restraints from contact prediction
2832 if (dhpb1(i).gt.0.0d0) then
2833 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2834 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2835 c write (iout,*) "beta nmr",
2836 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2840 C Get the force constant corresponding to this distance.
2842 C Calculate the contribution to energy.
2843 ehpb=ehpb+waga*rdis*rdis
2844 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2846 C Evaluate gradient.
2851 ggg(j)=fac*(c(j,jj)-c(j,ii))
2854 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2855 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2858 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2859 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2862 C Calculate the distance between the two points and its difference from the
2865 if (dhpb1(i).gt.0.0d0) then
2866 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2867 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2868 c write (iout,*) "alph nmr",
2869 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2872 C Get the force constant corresponding to this distance.
2874 C Calculate the contribution to energy.
2875 ehpb=ehpb+waga*rdis*rdis
2876 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2878 C Evaluate gradient.
2882 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2883 cd & ' waga=',waga,' fac=',fac
2885 ggg(j)=fac*(c(j,jj)-c(j,ii))
2887 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2888 C If this is a SC-SC distance, we need to calculate the contributions to the
2889 C Cartesian gradient in the SC vectors (ghpbx).
2892 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2893 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2897 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2898 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2905 C--------------------------------------------------------------------------
2906 subroutine ssbond_ene(i,j,eij)
2908 C Calculate the distance and angle dependent SS-bond potential energy
2909 C using a free-energy function derived based on RHF/6-31G** ab initio
2910 C calculations of diethyl disulfide.
2912 C A. Liwo and U. Kozlowska, 11/24/03
2914 implicit real*8 (a-h,o-z)
2915 include 'DIMENSIONS'
2916 include 'sizesclu.dat'
2917 include 'COMMON.SBRIDGE'
2918 include 'COMMON.CHAIN'
2919 include 'COMMON.DERIV'
2920 include 'COMMON.LOCAL'
2921 include 'COMMON.INTERACT'
2922 include 'COMMON.VAR'
2923 include 'COMMON.IOUNITS'
2924 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2929 dxi=dc_norm(1,nres+i)
2930 dyi=dc_norm(2,nres+i)
2931 dzi=dc_norm(3,nres+i)
2932 dsci_inv=dsc_inv(itypi)
2934 dscj_inv=dsc_inv(itypj)
2938 dxj=dc_norm(1,nres+j)
2939 dyj=dc_norm(2,nres+j)
2940 dzj=dc_norm(3,nres+j)
2941 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2946 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2947 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2948 om12=dxi*dxj+dyi*dyj+dzi*dzj
2950 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2951 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2957 deltat12=om2-om1+2.0d0
2959 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2960 & +akct*deltad*deltat12
2961 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2962 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2963 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2964 c & " deltat12",deltat12," eij",eij
2965 ed=2*akcm*deltad+akct*deltat12
2967 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
2968 eom1=-2*akth*deltat1-pom1-om2*pom2
2969 eom2= 2*akth*deltat2+pom1-om1*pom2
2972 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2975 ghpbx(k,i)=ghpbx(k,i)-gg(k)
2976 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
2977 ghpbx(k,j)=ghpbx(k,j)+gg(k)
2978 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
2981 C Calculate the components of the gradient in DC and X
2985 ghpbc(l,k)=ghpbc(l,k)+gg(l)
2990 C--------------------------------------------------------------------------
2991 subroutine ebond(estr)
2993 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
2995 implicit real*8 (a-h,o-z)
2996 include 'DIMENSIONS'
2997 include 'COMMON.LOCAL'
2998 include 'COMMON.GEO'
2999 include 'COMMON.INTERACT'
3000 include 'COMMON.DERIV'
3001 include 'COMMON.VAR'
3002 include 'COMMON.CHAIN'
3003 include 'COMMON.IOUNITS'
3004 include 'COMMON.NAMES'
3005 include 'COMMON.FFIELD'
3006 include 'COMMON.CONTROL'
3007 double precision u(3),ud(3)
3010 diff = vbld(i)-vbldp0
3011 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3014 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3019 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3026 diff=vbld(i+nres)-vbldsc0(1,iti)
3027 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3028 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3029 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3031 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3035 diff=vbld(i+nres)-vbldsc0(j,iti)
3036 ud(j)=aksc(j,iti)*diff
3037 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3051 uprod2=uprod2*u(k)*u(k)
3055 usumsqder=usumsqder+ud(j)*uprod2
3057 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3058 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3059 estr=estr+uprod/usum
3061 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3069 C--------------------------------------------------------------------------
3070 subroutine ebend(etheta)
3072 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3073 C angles gamma and its derivatives in consecutive thetas and gammas.
3075 implicit real*8 (a-h,o-z)
3076 include 'DIMENSIONS'
3077 include 'sizesclu.dat'
3078 include 'COMMON.LOCAL'
3079 include 'COMMON.GEO'
3080 include 'COMMON.INTERACT'
3081 include 'COMMON.DERIV'
3082 include 'COMMON.VAR'
3083 include 'COMMON.CHAIN'
3084 include 'COMMON.IOUNITS'
3085 include 'COMMON.NAMES'
3086 include 'COMMON.FFIELD'
3087 common /calcthet/ term1,term2,termm,diffak,ratak,
3088 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3089 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3090 double precision y(2),z(2)
3092 time11=dexp(-2*time)
3095 c write (iout,*) "nres",nres
3096 c write (*,'(a,i2)') 'EBEND ICG=',icg
3097 c write (iout,*) ithet_start,ithet_end
3098 do i=ithet_start,ithet_end
3099 C Zero the energy function and its derivative at 0 or pi.
3100 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3102 c if (i.gt.ithet_start .and.
3103 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3104 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3112 c if (i.lt.nres .and. itel(i).ne.0) then
3124 call proc_proc(phii,icrc)
3125 if (icrc.eq.1) phii=150.0
3139 call proc_proc(phii1,icrc)
3140 if (icrc.eq.1) phii1=150.0
3152 C Calculate the "mean" value of theta from the part of the distribution
3153 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3154 C In following comments this theta will be referred to as t_c.
3155 thet_pred_mean=0.0d0
3159 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3161 c write (iout,*) "thet_pred_mean",thet_pred_mean
3162 dthett=thet_pred_mean*ssd
3163 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3164 c write (iout,*) "thet_pred_mean",thet_pred_mean
3165 C Derivatives of the "mean" values in gamma1 and gamma2.
3166 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3167 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3168 if (theta(i).gt.pi-delta) then
3169 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3171 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3172 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3173 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3175 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3177 else if (theta(i).lt.delta) then
3178 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3179 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3180 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3182 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3183 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3186 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3189 etheta=etheta+ethetai
3190 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3191 c & rad2deg*phii,rad2deg*phii1,ethetai
3192 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3193 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3194 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3197 C Ufff.... We've done all this!!!
3200 C---------------------------------------------------------------------------
3201 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3203 implicit real*8 (a-h,o-z)
3204 include 'DIMENSIONS'
3205 include 'COMMON.LOCAL'
3206 include 'COMMON.IOUNITS'
3207 common /calcthet/ term1,term2,termm,diffak,ratak,
3208 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3209 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3210 C Calculate the contributions to both Gaussian lobes.
3211 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3212 C The "polynomial part" of the "standard deviation" of this part of
3216 sig=sig*thet_pred_mean+polthet(j,it)
3218 C Derivative of the "interior part" of the "standard deviation of the"
3219 C gamma-dependent Gaussian lobe in t_c.
3220 sigtc=3*polthet(3,it)
3222 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3225 C Set the parameters of both Gaussian lobes of the distribution.
3226 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3227 fac=sig*sig+sigc0(it)
3230 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3231 sigsqtc=-4.0D0*sigcsq*sigtc
3232 c print *,i,sig,sigtc,sigsqtc
3233 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3234 sigtc=-sigtc/(fac*fac)
3235 C Following variable is sigma(t_c)**(-2)
3236 sigcsq=sigcsq*sigcsq
3238 sig0inv=1.0D0/sig0i**2
3239 delthec=thetai-thet_pred_mean
3240 delthe0=thetai-theta0i
3241 term1=-0.5D0*sigcsq*delthec*delthec
3242 term2=-0.5D0*sig0inv*delthe0*delthe0
3243 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3244 C NaNs in taking the logarithm. We extract the largest exponent which is added
3245 C to the energy (this being the log of the distribution) at the end of energy
3246 C term evaluation for this virtual-bond angle.
3247 if (term1.gt.term2) then
3249 term2=dexp(term2-termm)
3253 term1=dexp(term1-termm)
3256 C The ratio between the gamma-independent and gamma-dependent lobes of
3257 C the distribution is a Gaussian function of thet_pred_mean too.
3258 diffak=gthet(2,it)-thet_pred_mean
3259 ratak=diffak/gthet(3,it)**2
3260 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3261 C Let's differentiate it in thet_pred_mean NOW.
3263 C Now put together the distribution terms to make complete distribution.
3264 termexp=term1+ak*term2
3265 termpre=sigc+ak*sig0i
3266 C Contribution of the bending energy from this theta is just the -log of
3267 C the sum of the contributions from the two lobes and the pre-exponential
3268 C factor. Simple enough, isn't it?
3269 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3270 C NOW the derivatives!!!
3271 C 6/6/97 Take into account the deformation.
3272 E_theta=(delthec*sigcsq*term1
3273 & +ak*delthe0*sig0inv*term2)/termexp
3274 E_tc=((sigtc+aktc*sig0i)/termpre
3275 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3276 & aktc*term2)/termexp)
3279 c-----------------------------------------------------------------------------
3280 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3281 implicit real*8 (a-h,o-z)
3282 include 'DIMENSIONS'
3283 include 'COMMON.LOCAL'
3284 include 'COMMON.IOUNITS'
3285 common /calcthet/ term1,term2,termm,diffak,ratak,
3286 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3287 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3288 delthec=thetai-thet_pred_mean
3289 delthe0=thetai-theta0i
3290 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3291 t3 = thetai-thet_pred_mean
3295 t14 = t12+t6*sigsqtc
3297 t21 = thetai-theta0i
3303 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3304 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3305 & *(-t12*t9-ak*sig0inv*t27)
3309 C--------------------------------------------------------------------------
3310 subroutine ebend(etheta)
3312 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3313 C angles gamma and its derivatives in consecutive thetas and gammas.
3314 C ab initio-derived potentials from
3315 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3317 implicit real*8 (a-h,o-z)
3318 include 'DIMENSIONS'
3319 include 'COMMON.LOCAL'
3320 include 'COMMON.GEO'
3321 include 'COMMON.INTERACT'
3322 include 'COMMON.DERIV'
3323 include 'COMMON.VAR'
3324 include 'COMMON.CHAIN'
3325 include 'COMMON.IOUNITS'
3326 include 'COMMON.NAMES'
3327 include 'COMMON.FFIELD'
3328 include 'COMMON.CONTROL'
3329 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3330 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3331 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3332 & sinph1ph2(maxdouble,maxdouble)
3333 logical lprn /.false./, lprn1 /.false./
3335 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3336 do i=ithet_start,ithet_end
3340 theti2=0.5d0*theta(i)
3341 ityp2=ithetyp(itype(i-1))
3343 coskt(k)=dcos(k*theti2)
3344 sinkt(k)=dsin(k*theti2)
3349 if (phii.ne.phii) phii=150.0
3353 ityp1=ithetyp(itype(i-2))
3355 cosph1(k)=dcos(k*phii)
3356 sinph1(k)=dsin(k*phii)
3369 if (phii1.ne.phii1) phii1=150.0
3374 ityp3=ithetyp(itype(i))
3376 cosph2(k)=dcos(k*phii1)
3377 sinph2(k)=dsin(k*phii1)
3387 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3388 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3390 ethetai=aa0thet(ityp1,ityp2,ityp3)
3393 ccl=cosph1(l)*cosph2(k-l)
3394 ssl=sinph1(l)*sinph2(k-l)
3395 scl=sinph1(l)*cosph2(k-l)
3396 csl=cosph1(l)*sinph2(k-l)
3397 cosph1ph2(l,k)=ccl-ssl
3398 cosph1ph2(k,l)=ccl+ssl
3399 sinph1ph2(l,k)=scl+csl
3400 sinph1ph2(k,l)=scl-csl
3404 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3405 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3406 write (iout,*) "coskt and sinkt"
3408 write (iout,*) k,coskt(k),sinkt(k)
3412 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3413 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3416 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3417 & " ethetai",ethetai
3420 write (iout,*) "cosph and sinph"
3422 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3424 write (iout,*) "cosph1ph2 and sinph2ph2"
3427 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3428 & sinph1ph2(l,k),sinph1ph2(k,l)
3431 write(iout,*) "ethetai",ethetai
3435 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3436 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3437 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3438 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3439 ethetai=ethetai+sinkt(m)*aux
3440 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3441 dephii=dephii+k*sinkt(m)*(
3442 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3443 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3444 dephii1=dephii1+k*sinkt(m)*(
3445 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3446 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3448 & write (iout,*) "m",m," k",k," bbthet",
3449 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3450 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3451 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3452 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3456 & write(iout,*) "ethetai",ethetai
3460 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3461 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3462 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3463 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3464 ethetai=ethetai+sinkt(m)*aux
3465 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3466 dephii=dephii+l*sinkt(m)*(
3467 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3468 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3469 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3470 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3471 dephii1=dephii1+(k-l)*sinkt(m)*(
3472 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3473 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3474 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3475 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3477 write (iout,*) "m",m," k",k," l",l," ffthet",
3478 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3479 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3480 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3481 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3482 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3483 & cosph1ph2(k,l)*sinkt(m),
3484 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3490 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3491 & i,theta(i)*rad2deg,phii*rad2deg,
3492 & phii1*rad2deg,ethetai
3493 etheta=etheta+ethetai
3494 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3495 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3496 gloc(nphi+i-2,icg)=wang*dethetai
3502 c-----------------------------------------------------------------------------
3503 subroutine esc(escloc)
3504 C Calculate the local energy of a side chain and its derivatives in the
3505 C corresponding virtual-bond valence angles THETA and the spherical angles
3507 implicit real*8 (a-h,o-z)
3508 include 'DIMENSIONS'
3509 include 'sizesclu.dat'
3510 include 'COMMON.GEO'
3511 include 'COMMON.LOCAL'
3512 include 'COMMON.VAR'
3513 include 'COMMON.INTERACT'
3514 include 'COMMON.DERIV'
3515 include 'COMMON.CHAIN'
3516 include 'COMMON.IOUNITS'
3517 include 'COMMON.NAMES'
3518 include 'COMMON.FFIELD'
3519 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3520 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3521 common /sccalc/ time11,time12,time112,theti,it,nlobit
3524 c write (iout,'(a)') 'ESC'
3525 do i=loc_start,loc_end
3527 if (it.eq.10) goto 1
3529 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3530 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3531 theti=theta(i+1)-pipol
3535 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3537 if (x(2).gt.pi-delta) then
3541 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3543 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3544 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3546 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3547 & ddersc0(1),dersc(1))
3548 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3549 & ddersc0(3),dersc(3))
3551 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3553 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3554 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3555 & dersc0(2),esclocbi,dersc02)
3556 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3558 call splinthet(x(2),0.5d0*delta,ss,ssd)
3563 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3565 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3566 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3568 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3570 c write (iout,*) escloci
3571 else if (x(2).lt.delta) then
3575 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3577 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3578 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3580 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3581 & ddersc0(1),dersc(1))
3582 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3583 & ddersc0(3),dersc(3))
3585 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3587 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3588 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3589 & dersc0(2),esclocbi,dersc02)
3590 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3595 call splinthet(x(2),0.5d0*delta,ss,ssd)
3597 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3599 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3600 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3602 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3603 c write (iout,*) escloci
3605 call enesc(x,escloci,dersc,ddummy,.false.)
3608 escloc=escloc+escloci
3609 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3611 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3613 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3614 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3619 C---------------------------------------------------------------------------
3620 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3621 implicit real*8 (a-h,o-z)
3622 include 'DIMENSIONS'
3623 include 'COMMON.GEO'
3624 include 'COMMON.LOCAL'
3625 include 'COMMON.IOUNITS'
3626 common /sccalc/ time11,time12,time112,theti,it,nlobit
3627 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3628 double precision contr(maxlob,-1:1)
3630 c write (iout,*) 'it=',it,' nlobit=',nlobit
3634 if (mixed) ddersc(j)=0.0d0
3638 C Because of periodicity of the dependence of the SC energy in omega we have
3639 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3640 C To avoid underflows, first compute & store the exponents.
3648 z(k)=x(k)-censc(k,j,it)
3653 Axk=Axk+gaussc(l,k,j,it)*z(l)
3659 expfac=expfac+Ax(k,j,iii)*z(k)
3667 C As in the case of ebend, we want to avoid underflows in exponentiation and
3668 C subsequent NaNs and INFs in energy calculation.
3669 C Find the largest exponent
3673 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3677 cd print *,'it=',it,' emin=',emin
3679 C Compute the contribution to SC energy and derivatives
3683 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3684 cd print *,'j=',j,' expfac=',expfac
3685 escloc_i=escloc_i+expfac
3687 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3691 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3692 & +gaussc(k,2,j,it))*expfac
3699 dersc(1)=dersc(1)/cos(theti)**2
3700 ddersc(1)=ddersc(1)/cos(theti)**2
3703 escloci=-(dlog(escloc_i)-emin)
3705 dersc(j)=dersc(j)/escloc_i
3709 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3714 C------------------------------------------------------------------------------
3715 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3716 implicit real*8 (a-h,o-z)
3717 include 'DIMENSIONS'
3718 include 'COMMON.GEO'
3719 include 'COMMON.LOCAL'
3720 include 'COMMON.IOUNITS'
3721 common /sccalc/ time11,time12,time112,theti,it,nlobit
3722 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3723 double precision contr(maxlob)
3734 z(k)=x(k)-censc(k,j,it)
3740 Axk=Axk+gaussc(l,k,j,it)*z(l)
3746 expfac=expfac+Ax(k,j)*z(k)
3751 C As in the case of ebend, we want to avoid underflows in exponentiation and
3752 C subsequent NaNs and INFs in energy calculation.
3753 C Find the largest exponent
3756 if (emin.gt.contr(j)) emin=contr(j)
3760 C Compute the contribution to SC energy and derivatives
3764 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3765 escloc_i=escloc_i+expfac
3767 dersc(k)=dersc(k)+Ax(k,j)*expfac
3769 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3770 & +gaussc(1,2,j,it))*expfac
3774 dersc(1)=dersc(1)/cos(theti)**2
3775 dersc12=dersc12/cos(theti)**2
3776 escloci=-(dlog(escloc_i)-emin)
3778 dersc(j)=dersc(j)/escloc_i
3780 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3784 c----------------------------------------------------------------------------------
3785 subroutine esc(escloc)
3786 C Calculate the local energy of a side chain and its derivatives in the
3787 C corresponding virtual-bond valence angles THETA and the spherical angles
3788 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3789 C added by Urszula Kozlowska. 07/11/2007
3791 implicit real*8 (a-h,o-z)
3792 include 'DIMENSIONS'
3793 include 'COMMON.GEO'
3794 include 'COMMON.LOCAL'
3795 include 'COMMON.VAR'
3796 include 'COMMON.SCROT'
3797 include 'COMMON.INTERACT'
3798 include 'COMMON.DERIV'
3799 include 'COMMON.CHAIN'
3800 include 'COMMON.IOUNITS'
3801 include 'COMMON.NAMES'
3802 include 'COMMON.FFIELD'
3803 include 'COMMON.CONTROL'
3804 include 'COMMON.VECTORS'
3805 double precision x_prime(3),y_prime(3),z_prime(3)
3806 & , sumene,dsc_i,dp2_i,x(65),
3807 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3808 & de_dxx,de_dyy,de_dzz,de_dt
3809 double precision s1_t,s1_6_t,s2_t,s2_6_t
3811 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3812 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3813 & dt_dCi(3),dt_dCi1(3)
3814 common /sccalc/ time11,time12,time112,theti,it,nlobit
3817 do i=loc_start,loc_end
3818 costtab(i+1) =dcos(theta(i+1))
3819 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3820 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3821 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3822 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3823 cosfac=dsqrt(cosfac2)
3824 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3825 sinfac=dsqrt(sinfac2)
3827 if (it.eq.10) goto 1
3829 C Compute the axes of tghe local cartesian coordinates system; store in
3830 c x_prime, y_prime and z_prime
3837 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3838 C & dc_norm(3,i+nres)
3840 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3841 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3844 z_prime(j) = -uz(j,i-1)
3847 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3848 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3849 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3850 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3851 c & " xy",scalar(x_prime(1),y_prime(1)),
3852 c & " xz",scalar(x_prime(1),z_prime(1)),
3853 c & " yy",scalar(y_prime(1),y_prime(1)),
3854 c & " yz",scalar(y_prime(1),z_prime(1)),
3855 c & " zz",scalar(z_prime(1),z_prime(1))
3857 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3858 C to local coordinate system. Store in xx, yy, zz.
3864 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3865 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3866 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3873 C Compute the energy of the ith side cbain
3875 c write (2,*) "xx",xx," yy",yy," zz",zz
3878 x(j) = sc_parmin(j,it)
3881 Cc diagnostics - remove later
3883 yy1 = dsin(alph(2))*dcos(omeg(2))
3884 zz1 = -dsin(alph(2))*dsin(omeg(2))
3885 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3886 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3888 C," --- ", xx_w,yy_w,zz_w
3891 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3892 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3894 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3895 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3897 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3898 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3899 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3900 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3901 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3903 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3904 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3905 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3906 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3907 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3909 dsc_i = 0.743d0+x(61)
3911 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3912 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3913 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3914 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3915 s1=(1+x(63))/(0.1d0 + dscp1)
3916 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3917 s2=(1+x(65))/(0.1d0 + dscp2)
3918 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3919 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3920 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3921 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3923 c & dscp1,dscp2,sumene
3924 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3925 escloc = escloc + sumene
3926 c write (2,*) "escloc",escloc
3927 if (.not. calc_grad) goto 1
3930 C This section to check the numerical derivatives of the energy of ith side
3931 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3932 C #define DEBUG in the code to turn it on.
3934 write (2,*) "sumene =",sumene
3938 write (2,*) xx,yy,zz
3939 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3940 de_dxx_num=(sumenep-sumene)/aincr
3942 write (2,*) "xx+ sumene from enesc=",sumenep
3945 write (2,*) xx,yy,zz
3946 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3947 de_dyy_num=(sumenep-sumene)/aincr
3949 write (2,*) "yy+ sumene from enesc=",sumenep
3952 write (2,*) xx,yy,zz
3953 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3954 de_dzz_num=(sumenep-sumene)/aincr
3956 write (2,*) "zz+ sumene from enesc=",sumenep
3957 costsave=cost2tab(i+1)
3958 sintsave=sint2tab(i+1)
3959 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
3960 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
3961 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3962 de_dt_num=(sumenep-sumene)/aincr
3963 write (2,*) " t+ sumene from enesc=",sumenep
3964 cost2tab(i+1)=costsave
3965 sint2tab(i+1)=sintsave
3966 C End of diagnostics section.
3969 C Compute the gradient of esc
3971 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
3972 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
3973 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
3974 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
3975 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
3976 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
3977 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
3978 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
3979 pom1=(sumene3*sint2tab(i+1)+sumene1)
3980 & *(pom_s1/dscp1+pom_s16*dscp1**4)
3981 pom2=(sumene4*cost2tab(i+1)+sumene2)
3982 & *(pom_s2/dscp2+pom_s26*dscp2**4)
3983 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
3984 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
3985 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
3987 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
3988 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
3989 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
3991 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
3992 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
3993 & +(pom1+pom2)*pom_dx
3995 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
3998 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
3999 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4000 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4002 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4003 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4004 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4005 & +x(59)*zz**2 +x(60)*xx*zz
4006 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4007 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4008 & +(pom1-pom2)*pom_dy
4010 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4013 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4014 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4015 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4016 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4017 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4018 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4019 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4020 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4022 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4025 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4026 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4027 & +pom1*pom_dt1+pom2*pom_dt2
4029 write(2,*), "de_dt = ", de_dt,de_dt_num
4033 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4034 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4035 cosfac2xx=cosfac2*xx
4036 sinfac2yy=sinfac2*yy
4038 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4040 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4042 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4043 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4044 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4045 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4046 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4047 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4048 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4049 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4050 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4051 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4055 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4056 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4059 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4060 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4061 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4063 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4064 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4068 dXX_Ctab(k,i)=dXX_Ci(k)
4069 dXX_C1tab(k,i)=dXX_Ci1(k)
4070 dYY_Ctab(k,i)=dYY_Ci(k)
4071 dYY_C1tab(k,i)=dYY_Ci1(k)
4072 dZZ_Ctab(k,i)=dZZ_Ci(k)
4073 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4074 dXX_XYZtab(k,i)=dXX_XYZ(k)
4075 dYY_XYZtab(k,i)=dYY_XYZ(k)
4076 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4080 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4081 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4082 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4083 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4084 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4086 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4087 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4088 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4089 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4090 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4091 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4092 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4093 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4095 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4096 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4098 C to check gradient call subroutine check_grad
4105 c------------------------------------------------------------------------------
4106 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4108 C This procedure calculates two-body contact function g(rij) and its derivative:
4111 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4114 C where x=(rij-r0ij)/delta
4116 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4119 double precision rij,r0ij,eps0ij,fcont,fprimcont
4120 double precision x,x2,x4,delta
4124 if (x.lt.-1.0D0) then
4127 else if (x.le.1.0D0) then
4130 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4131 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4138 c------------------------------------------------------------------------------
4139 subroutine splinthet(theti,delta,ss,ssder)
4140 implicit real*8 (a-h,o-z)
4141 include 'DIMENSIONS'
4142 include 'sizesclu.dat'
4143 include 'COMMON.VAR'
4144 include 'COMMON.GEO'
4147 if (theti.gt.pipol) then
4148 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4150 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4155 c------------------------------------------------------------------------------
4156 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4158 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4159 double precision ksi,ksi2,ksi3,a1,a2,a3
4160 a1=fprim0*delta/(f1-f0)
4166 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4167 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4170 c------------------------------------------------------------------------------
4171 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4173 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4174 double precision ksi,ksi2,ksi3,a1,a2,a3
4179 a2=3*(f1x-f0x)-2*fprim0x*delta
4180 a3=fprim0x*delta-2*(f1x-f0x)
4181 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4184 C-----------------------------------------------------------------------------
4186 C-----------------------------------------------------------------------------
4187 subroutine etor(etors,edihcnstr,fact)
4188 implicit real*8 (a-h,o-z)
4189 include 'DIMENSIONS'
4190 include 'sizesclu.dat'
4191 include 'COMMON.VAR'
4192 include 'COMMON.GEO'
4193 include 'COMMON.LOCAL'
4194 include 'COMMON.TORSION'
4195 include 'COMMON.INTERACT'
4196 include 'COMMON.DERIV'
4197 include 'COMMON.CHAIN'
4198 include 'COMMON.NAMES'
4199 include 'COMMON.IOUNITS'
4200 include 'COMMON.FFIELD'
4201 include 'COMMON.TORCNSTR'
4203 C Set lprn=.true. for debugging
4207 do i=iphi_start,iphi_end
4208 itori=itortyp(itype(i-2))
4209 itori1=itortyp(itype(i-1))
4212 C Proline-Proline pair is a special case...
4213 if (itori.eq.3 .and. itori1.eq.3) then
4214 if (phii.gt.-dwapi3) then
4216 fac=1.0D0/(1.0D0-cosphi)
4217 etorsi=v1(1,3,3)*fac
4218 etorsi=etorsi+etorsi
4219 etors=etors+etorsi-v1(1,3,3)
4220 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4223 v1ij=v1(j+1,itori,itori1)
4224 v2ij=v2(j+1,itori,itori1)
4227 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4228 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4232 v1ij=v1(j,itori,itori1)
4233 v2ij=v2(j,itori,itori1)
4236 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4237 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4241 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4242 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4243 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4244 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4245 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4247 ! 6/20/98 - dihedral angle constraints
4250 itori=idih_constr(i)
4252 difi=pinorm(phii-phi0(i))
4253 if (difi.gt.drange(i)) then
4255 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4256 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4257 else if (difi.lt.-drange(i)) then
4259 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4260 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4262 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4263 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4265 write (iout,*) 'edihcnstr',edihcnstr
4268 c------------------------------------------------------------------------------
4270 subroutine etor(etors,edihcnstr,fact)
4271 implicit real*8 (a-h,o-z)
4272 include 'DIMENSIONS'
4273 include 'sizesclu.dat'
4274 include 'COMMON.VAR'
4275 include 'COMMON.GEO'
4276 include 'COMMON.LOCAL'
4277 include 'COMMON.TORSION'
4278 include 'COMMON.INTERACT'
4279 include 'COMMON.DERIV'
4280 include 'COMMON.CHAIN'
4281 include 'COMMON.NAMES'
4282 include 'COMMON.IOUNITS'
4283 include 'COMMON.FFIELD'
4284 include 'COMMON.TORCNSTR'
4286 C Set lprn=.true. for debugging
4290 do i=iphi_start,iphi_end
4291 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4292 itori=itortyp(itype(i-2))
4293 itori1=itortyp(itype(i-1))
4296 C Regular cosine and sine terms
4297 do j=1,nterm(itori,itori1)
4298 v1ij=v1(j,itori,itori1)
4299 v2ij=v2(j,itori,itori1)
4302 etors=etors+v1ij*cosphi+v2ij*sinphi
4303 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4307 C E = SUM ----------------------------------- - v1
4308 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4310 cosphi=dcos(0.5d0*phii)
4311 sinphi=dsin(0.5d0*phii)
4312 do j=1,nlor(itori,itori1)
4313 vl1ij=vlor1(j,itori,itori1)
4314 vl2ij=vlor2(j,itori,itori1)
4315 vl3ij=vlor3(j,itori,itori1)
4316 pom=vl2ij*cosphi+vl3ij*sinphi
4317 pom1=1.0d0/(pom*pom+1.0d0)
4318 etors=etors+vl1ij*pom1
4320 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4322 C Subtract the constant term
4323 etors=etors-v0(itori,itori1)
4325 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4326 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4327 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4328 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4329 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4332 ! 6/20/98 - dihedral angle constraints
4334 c write (iout,*) "Dihedral angle restraint energy"
4336 itori=idih_constr(i)
4338 difi=pinorm(phii-phi0(i))
4339 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
4340 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
4341 if (difi.gt.drange(i)) then
4343 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4344 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4345 c write (iout,*) 0.25d0*ftors*difi**4
4346 else if (difi.lt.-drange(i)) then
4348 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4349 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4350 c write (iout,*) 0.25d0*ftors*difi**4
4353 c write (iout,*) 'edihcnstr',edihcnstr
4356 c----------------------------------------------------------------------------
4357 subroutine etor_d(etors_d,fact2)
4358 C 6/23/01 Compute double torsional energy
4359 implicit real*8 (a-h,o-z)
4360 include 'DIMENSIONS'
4361 include 'sizesclu.dat'
4362 include 'COMMON.VAR'
4363 include 'COMMON.GEO'
4364 include 'COMMON.LOCAL'
4365 include 'COMMON.TORSION'
4366 include 'COMMON.INTERACT'
4367 include 'COMMON.DERIV'
4368 include 'COMMON.CHAIN'
4369 include 'COMMON.NAMES'
4370 include 'COMMON.IOUNITS'
4371 include 'COMMON.FFIELD'
4372 include 'COMMON.TORCNSTR'
4374 C Set lprn=.true. for debugging
4378 do i=iphi_start,iphi_end-1
4379 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4381 itori=itortyp(itype(i-2))
4382 itori1=itortyp(itype(i-1))
4383 itori2=itortyp(itype(i))
4388 C Regular cosine and sine terms
4389 do j=1,ntermd_1(itori,itori1,itori2)
4390 v1cij=v1c(1,j,itori,itori1,itori2)
4391 v1sij=v1s(1,j,itori,itori1,itori2)
4392 v2cij=v1c(2,j,itori,itori1,itori2)
4393 v2sij=v1s(2,j,itori,itori1,itori2)
4394 cosphi1=dcos(j*phii)
4395 sinphi1=dsin(j*phii)
4396 cosphi2=dcos(j*phii1)
4397 sinphi2=dsin(j*phii1)
4398 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4399 & v2cij*cosphi2+v2sij*sinphi2
4400 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4401 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4403 do k=2,ntermd_2(itori,itori1,itori2)
4405 v1cdij = v2c(k,l,itori,itori1,itori2)
4406 v2cdij = v2c(l,k,itori,itori1,itori2)
4407 v1sdij = v2s(k,l,itori,itori1,itori2)
4408 v2sdij = v2s(l,k,itori,itori1,itori2)
4409 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4410 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4411 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4412 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4413 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4414 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4415 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4416 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4417 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4418 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4421 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4422 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4428 c------------------------------------------------------------------------------
4429 subroutine eback_sc_corr(esccor,fact)
4430 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4431 c conformational states; temporarily implemented as differences
4432 c between UNRES torsional potentials (dependent on three types of
4433 c residues) and the torsional potentials dependent on all 20 types
4434 c of residues computed from AM1 energy surfaces of terminally-blocked
4435 c amino-acid residues.
4436 implicit real*8 (a-h,o-z)
4437 include 'DIMENSIONS'
4438 include 'COMMON.VAR'
4439 include 'COMMON.GEO'
4440 include 'COMMON.LOCAL'
4441 include 'COMMON.TORSION'
4442 include 'COMMON.SCCOR'
4443 include 'COMMON.INTERACT'
4444 include 'COMMON.DERIV'
4445 include 'COMMON.CHAIN'
4446 include 'COMMON.NAMES'
4447 include 'COMMON.IOUNITS'
4448 include 'COMMON.FFIELD'
4449 include 'COMMON.CONTROL'
4451 C Set lprn=.true. for debugging
4454 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4456 do i=iphi_start,iphi_end
4463 v1ij=v1sccor(j,itori,itori1)
4464 v2ij=v2sccor(j,itori,itori1)
4467 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4468 gloci=gloci+fact*j*(v2ij*cosphi-v1ij*sinphi)
4471 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4472 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4473 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
4474 gsccor_loc(i-3)=gloci
4478 c------------------------------------------------------------------------------
4479 subroutine multibody(ecorr)
4480 C This subroutine calculates multi-body contributions to energy following
4481 C the idea of Skolnick et al. If side chains I and J make a contact and
4482 C at the same time side chains I+1 and J+1 make a contact, an extra
4483 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4484 implicit real*8 (a-h,o-z)
4485 include 'DIMENSIONS'
4486 include 'COMMON.IOUNITS'
4487 include 'COMMON.DERIV'
4488 include 'COMMON.INTERACT'
4489 include 'COMMON.CONTACTS'
4490 double precision gx(3),gx1(3)
4493 C Set lprn=.true. for debugging
4497 write (iout,'(a)') 'Contact function values:'
4499 write (iout,'(i2,20(1x,i2,f10.5))')
4500 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4515 num_conti=num_cont(i)
4516 num_conti1=num_cont(i1)
4521 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4522 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4523 cd & ' ishift=',ishift
4524 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4525 C The system gains extra energy.
4526 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4527 endif ! j1==j+-ishift
4536 c------------------------------------------------------------------------------
4537 double precision function esccorr(i,j,k,l,jj,kk)
4538 implicit real*8 (a-h,o-z)
4539 include 'DIMENSIONS'
4540 include 'COMMON.IOUNITS'
4541 include 'COMMON.DERIV'
4542 include 'COMMON.INTERACT'
4543 include 'COMMON.CONTACTS'
4544 double precision gx(3),gx1(3)
4549 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4550 C Calculate the multi-body contribution to energy.
4551 C Calculate multi-body contributions to the gradient.
4552 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4553 cd & k,l,(gacont(m,kk,k),m=1,3)
4555 gx(m) =ekl*gacont(m,jj,i)
4556 gx1(m)=eij*gacont(m,kk,k)
4557 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4558 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4559 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4560 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4564 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4569 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4575 c------------------------------------------------------------------------------
4577 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4578 implicit real*8 (a-h,o-z)
4579 include 'DIMENSIONS'
4580 integer dimen1,dimen2,atom,indx
4581 double precision buffer(dimen1,dimen2)
4582 double precision zapas
4583 common /contacts_hb/ zapas(3,20,maxres,7),
4584 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4585 & num_cont_hb(maxres),jcont_hb(20,maxres)
4586 num_kont=num_cont_hb(atom)
4590 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4593 buffer(i,indx+22)=facont_hb(i,atom)
4594 buffer(i,indx+23)=ees0p(i,atom)
4595 buffer(i,indx+24)=ees0m(i,atom)
4596 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4598 buffer(1,indx+26)=dfloat(num_kont)
4601 c------------------------------------------------------------------------------
4602 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4603 implicit real*8 (a-h,o-z)
4604 include 'DIMENSIONS'
4605 integer dimen1,dimen2,atom,indx
4606 double precision buffer(dimen1,dimen2)
4607 double precision zapas
4608 common /contacts_hb/ zapas(3,20,maxres,7),
4609 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4610 & num_cont_hb(maxres),jcont_hb(20,maxres)
4611 num_kont=buffer(1,indx+26)
4612 num_kont_old=num_cont_hb(atom)
4613 num_cont_hb(atom)=num_kont+num_kont_old
4618 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4621 facont_hb(ii,atom)=buffer(i,indx+22)
4622 ees0p(ii,atom)=buffer(i,indx+23)
4623 ees0m(ii,atom)=buffer(i,indx+24)
4624 jcont_hb(ii,atom)=buffer(i,indx+25)
4628 c------------------------------------------------------------------------------
4630 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4631 C This subroutine calculates multi-body contributions to hydrogen-bonding
4632 implicit real*8 (a-h,o-z)
4633 include 'DIMENSIONS'
4634 include 'sizesclu.dat'
4635 include 'COMMON.IOUNITS'
4637 include 'COMMON.INFO'
4639 include 'COMMON.FFIELD'
4640 include 'COMMON.DERIV'
4641 include 'COMMON.INTERACT'
4642 include 'COMMON.CONTACTS'
4644 parameter (max_cont=maxconts)
4645 parameter (max_dim=2*(8*3+2))
4646 parameter (msglen1=max_cont*max_dim*4)
4647 parameter (msglen2=2*msglen1)
4648 integer source,CorrelType,CorrelID,Error
4649 double precision buffer(max_cont,max_dim)
4651 double precision gx(3),gx1(3)
4654 C Set lprn=.true. for debugging
4659 if (fgProcs.le.1) goto 30
4661 write (iout,'(a)') 'Contact function values:'
4663 write (iout,'(2i3,50(1x,i2,f5.2))')
4664 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4665 & j=1,num_cont_hb(i))
4668 C Caution! Following code assumes that electrostatic interactions concerning
4669 C a given atom are split among at most two processors!
4679 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4682 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4683 if (MyRank.gt.0) then
4684 C Send correlation contributions to the preceding processor
4686 nn=num_cont_hb(iatel_s)
4687 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4688 cd write (iout,*) 'The BUFFER array:'
4690 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4692 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4694 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4695 C Clear the contacts of the atom passed to the neighboring processor
4696 nn=num_cont_hb(iatel_s+1)
4698 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4700 num_cont_hb(iatel_s)=0
4702 cd write (iout,*) 'Processor ',MyID,MyRank,
4703 cd & ' is sending correlation contribution to processor',MyID-1,
4704 cd & ' msglen=',msglen
4705 cd write (*,*) 'Processor ',MyID,MyRank,
4706 cd & ' is sending correlation contribution to processor',MyID-1,
4707 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4708 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4709 cd write (iout,*) 'Processor ',MyID,
4710 cd & ' has sent correlation contribution to processor',MyID-1,
4711 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4712 cd write (*,*) 'Processor ',MyID,
4713 cd & ' has sent correlation contribution to processor',MyID-1,
4714 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4716 endif ! (MyRank.gt.0)
4720 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4721 if (MyRank.lt.fgProcs-1) then
4722 C Receive correlation contributions from the next processor
4724 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4725 cd write (iout,*) 'Processor',MyID,
4726 cd & ' is receiving correlation contribution from processor',MyID+1,
4727 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4728 cd write (*,*) 'Processor',MyID,
4729 cd & ' is receiving correlation contribution from processor',MyID+1,
4730 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4732 do while (nbytes.le.0)
4733 call mp_probe(MyID+1,CorrelType,nbytes)
4735 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4736 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4737 cd write (iout,*) 'Processor',MyID,
4738 cd & ' has received correlation contribution from processor',MyID+1,
4739 cd & ' msglen=',msglen,' nbytes=',nbytes
4740 cd write (iout,*) 'The received BUFFER array:'
4742 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4744 if (msglen.eq.msglen1) then
4745 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4746 else if (msglen.eq.msglen2) then
4747 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4748 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4751 & 'ERROR!!!! message length changed while processing correlations.'
4753 & 'ERROR!!!! message length changed while processing correlations.'
4754 call mp_stopall(Error)
4755 endif ! msglen.eq.msglen1
4756 endif ! MyRank.lt.fgProcs-1
4763 write (iout,'(a)') 'Contact function values:'
4765 write (iout,'(2i3,50(1x,i2,f5.2))')
4766 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4767 & j=1,num_cont_hb(i))
4771 C Remove the loop below after debugging !!!
4778 C Calculate the local-electrostatic correlation terms
4779 do i=iatel_s,iatel_e+1
4781 num_conti=num_cont_hb(i)
4782 num_conti1=num_cont_hb(i+1)
4787 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4788 c & ' jj=',jj,' kk=',kk
4789 if (j1.eq.j+1 .or. j1.eq.j-1) then
4790 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4791 C The system gains extra energy.
4792 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4794 else if (j1.eq.j) then
4795 C Contacts I-J and I-(J+1) occur simultaneously.
4796 C The system loses extra energy.
4797 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4802 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4803 c & ' jj=',jj,' kk=',kk
4805 C Contacts I-J and (I+1)-J occur simultaneously.
4806 C The system loses extra energy.
4807 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4814 c------------------------------------------------------------------------------
4815 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4817 C This subroutine calculates multi-body contributions to hydrogen-bonding
4818 implicit real*8 (a-h,o-z)
4819 include 'DIMENSIONS'
4820 include 'sizesclu.dat'
4821 include 'COMMON.IOUNITS'
4823 include 'COMMON.INFO'
4825 include 'COMMON.FFIELD'
4826 include 'COMMON.DERIV'
4827 include 'COMMON.INTERACT'
4828 include 'COMMON.CONTACTS'
4830 parameter (max_cont=maxconts)
4831 parameter (max_dim=2*(8*3+2))
4832 parameter (msglen1=max_cont*max_dim*4)
4833 parameter (msglen2=2*msglen1)
4834 integer source,CorrelType,CorrelID,Error
4835 double precision buffer(max_cont,max_dim)
4837 double precision gx(3),gx1(3)
4840 C Set lprn=.true. for debugging
4846 if (fgProcs.le.1) goto 30
4848 write (iout,'(a)') 'Contact function values:'
4850 write (iout,'(2i3,50(1x,i2,f5.2))')
4851 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4852 & j=1,num_cont_hb(i))
4855 C Caution! Following code assumes that electrostatic interactions concerning
4856 C a given atom are split among at most two processors!
4866 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4869 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4870 if (MyRank.gt.0) then
4871 C Send correlation contributions to the preceding processor
4873 nn=num_cont_hb(iatel_s)
4874 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4875 cd write (iout,*) 'The BUFFER array:'
4877 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4879 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4881 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4882 C Clear the contacts of the atom passed to the neighboring processor
4883 nn=num_cont_hb(iatel_s+1)
4885 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4887 num_cont_hb(iatel_s)=0
4889 cd write (iout,*) 'Processor ',MyID,MyRank,
4890 cd & ' is sending correlation contribution to processor',MyID-1,
4891 cd & ' msglen=',msglen
4892 cd write (*,*) 'Processor ',MyID,MyRank,
4893 cd & ' is sending correlation contribution to processor',MyID-1,
4894 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4895 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4896 cd write (iout,*) 'Processor ',MyID,
4897 cd & ' has sent correlation contribution to processor',MyID-1,
4898 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4899 cd write (*,*) 'Processor ',MyID,
4900 cd & ' has sent correlation contribution to processor',MyID-1,
4901 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4903 endif ! (MyRank.gt.0)
4907 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4908 if (MyRank.lt.fgProcs-1) then
4909 C Receive correlation contributions from the next processor
4911 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4912 cd write (iout,*) 'Processor',MyID,
4913 cd & ' is receiving correlation contribution from processor',MyID+1,
4914 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4915 cd write (*,*) 'Processor',MyID,
4916 cd & ' is receiving correlation contribution from processor',MyID+1,
4917 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4919 do while (nbytes.le.0)
4920 call mp_probe(MyID+1,CorrelType,nbytes)
4922 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4923 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4924 cd write (iout,*) 'Processor',MyID,
4925 cd & ' has received correlation contribution from processor',MyID+1,
4926 cd & ' msglen=',msglen,' nbytes=',nbytes
4927 cd write (iout,*) 'The received BUFFER array:'
4929 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4931 if (msglen.eq.msglen1) then
4932 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4933 else if (msglen.eq.msglen2) then
4934 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4935 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4938 & 'ERROR!!!! message length changed while processing correlations.'
4940 & 'ERROR!!!! message length changed while processing correlations.'
4941 call mp_stopall(Error)
4942 endif ! msglen.eq.msglen1
4943 endif ! MyRank.lt.fgProcs-1
4950 write (iout,'(a)') 'Contact function values:'
4952 write (iout,'(2i3,50(1x,i2,f5.2))')
4953 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4954 & j=1,num_cont_hb(i))
4960 C Remove the loop below after debugging !!!
4967 C Calculate the dipole-dipole interaction energies
4968 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
4969 do i=iatel_s,iatel_e+1
4970 num_conti=num_cont_hb(i)
4977 C Calculate the local-electrostatic correlation terms
4978 do i=iatel_s,iatel_e+1
4980 num_conti=num_cont_hb(i)
4981 num_conti1=num_cont_hb(i+1)
4986 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4987 c & ' jj=',jj,' kk=',kk
4988 if (j1.eq.j+1 .or. j1.eq.j-1) then
4989 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4990 C The system gains extra energy.
4992 sqd1=dsqrt(d_cont(jj,i))
4993 sqd2=dsqrt(d_cont(kk,i1))
4994 sred_geom = sqd1*sqd2
4995 IF (sred_geom.lt.cutoff_corr) THEN
4996 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
4998 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4999 c & ' jj=',jj,' kk=',kk
5000 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5001 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5003 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5004 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5007 cd write (iout,*) 'sred_geom=',sred_geom,
5008 cd & ' ekont=',ekont,' fprim=',fprimcont
5009 call calc_eello(i,j,i+1,j1,jj,kk)
5010 if (wcorr4.gt.0.0d0)
5011 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5012 if (wcorr5.gt.0.0d0)
5013 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5014 c print *,"wcorr5",ecorr5
5015 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5016 cd write(2,*)'ijkl',i,j,i+1,j1
5017 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5018 & .or. wturn6.eq.0.0d0))then
5019 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5020 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5021 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5022 cd & 'ecorr6=',ecorr6
5023 cd write (iout,'(4e15.5)') sred_geom,
5024 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5025 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5026 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5027 else if (wturn6.gt.0.0d0
5028 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5029 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5030 eturn6=eturn6+eello_turn6(i,jj,kk)
5031 cd write (2,*) 'multibody_eello:eturn6',eturn6
5035 else if (j1.eq.j) then
5036 C Contacts I-J and I-(J+1) occur simultaneously.
5037 C The system loses extra energy.
5038 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5043 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5044 c & ' jj=',jj,' kk=',kk
5046 C Contacts I-J and (I+1)-J occur simultaneously.
5047 C The system loses extra energy.
5048 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5055 c------------------------------------------------------------------------------
5056 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5057 implicit real*8 (a-h,o-z)
5058 include 'DIMENSIONS'
5059 include 'COMMON.IOUNITS'
5060 include 'COMMON.DERIV'
5061 include 'COMMON.INTERACT'
5062 include 'COMMON.CONTACTS'
5063 double precision gx(3),gx1(3)
5073 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5074 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5075 C Following 4 lines for diagnostics.
5080 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5082 c write (iout,*)'Contacts have occurred for peptide groups',
5083 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5084 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5085 C Calculate the multi-body contribution to energy.
5086 ecorr=ecorr+ekont*ees
5088 C Calculate multi-body contributions to the gradient.
5090 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5091 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5092 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5093 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5094 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5095 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5096 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5097 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5098 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5099 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5100 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5101 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5102 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5103 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5107 gradcorr(ll,m)=gradcorr(ll,m)+
5108 & ees*ekl*gacont_hbr(ll,jj,i)-
5109 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5110 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5115 gradcorr(ll,m)=gradcorr(ll,m)+
5116 & ees*eij*gacont_hbr(ll,kk,k)-
5117 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5118 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5125 C---------------------------------------------------------------------------
5126 subroutine dipole(i,j,jj)
5127 implicit real*8 (a-h,o-z)
5128 include 'DIMENSIONS'
5129 include 'sizesclu.dat'
5130 include 'COMMON.IOUNITS'
5131 include 'COMMON.CHAIN'
5132 include 'COMMON.FFIELD'
5133 include 'COMMON.DERIV'
5134 include 'COMMON.INTERACT'
5135 include 'COMMON.CONTACTS'
5136 include 'COMMON.TORSION'
5137 include 'COMMON.VAR'
5138 include 'COMMON.GEO'
5139 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5141 iti1 = itortyp(itype(i+1))
5142 if (j.lt.nres-1) then
5143 itj1 = itortyp(itype(j+1))
5148 dipi(iii,1)=Ub2(iii,i)
5149 dipderi(iii)=Ub2der(iii,i)
5150 dipi(iii,2)=b1(iii,iti1)
5151 dipj(iii,1)=Ub2(iii,j)
5152 dipderj(iii)=Ub2der(iii,j)
5153 dipj(iii,2)=b1(iii,itj1)
5157 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5160 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5163 if (.not.calc_grad) return
5168 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5172 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5177 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5178 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5180 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5182 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5184 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5188 C---------------------------------------------------------------------------
5189 subroutine calc_eello(i,j,k,l,jj,kk)
5191 C This subroutine computes matrices and vectors needed to calculate
5192 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5194 implicit real*8 (a-h,o-z)
5195 include 'DIMENSIONS'
5196 include 'sizesclu.dat'
5197 include 'COMMON.IOUNITS'
5198 include 'COMMON.CHAIN'
5199 include 'COMMON.DERIV'
5200 include 'COMMON.INTERACT'
5201 include 'COMMON.CONTACTS'
5202 include 'COMMON.TORSION'
5203 include 'COMMON.VAR'
5204 include 'COMMON.GEO'
5205 include 'COMMON.FFIELD'
5206 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5207 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5210 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5211 cd & ' jj=',jj,' kk=',kk
5212 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5215 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5216 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5219 call transpose2(aa1(1,1),aa1t(1,1))
5220 call transpose2(aa2(1,1),aa2t(1,1))
5223 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5224 & aa1tder(1,1,lll,kkk))
5225 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5226 & aa2tder(1,1,lll,kkk))
5230 C parallel orientation of the two CA-CA-CA frames.
5232 iti=itortyp(itype(i))
5236 itk1=itortyp(itype(k+1))
5237 itj=itortyp(itype(j))
5238 if (l.lt.nres-1) then
5239 itl1=itortyp(itype(l+1))
5243 C A1 kernel(j+1) A2T
5245 cd write (iout,'(3f10.5,5x,3f10.5)')
5246 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5248 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5249 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5250 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5251 C Following matrices are needed only for 6-th order cumulants
5252 IF (wcorr6.gt.0.0d0) THEN
5253 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5254 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5255 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5256 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5257 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5258 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5259 & ADtEAderx(1,1,1,1,1,1))
5261 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5262 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5263 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5264 & ADtEA1derx(1,1,1,1,1,1))
5266 C End 6-th order cumulants
5269 cd write (2,*) 'In calc_eello6'
5271 cd write (2,*) 'iii=',iii
5273 cd write (2,*) 'kkk=',kkk
5275 cd write (2,'(3(2f10.5),5x)')
5276 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5281 call transpose2(EUgder(1,1,k),auxmat(1,1))
5282 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5283 call transpose2(EUg(1,1,k),auxmat(1,1))
5284 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5285 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5289 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5290 & EAEAderx(1,1,lll,kkk,iii,1))
5294 C A1T kernel(i+1) A2
5295 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5296 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5297 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5298 C Following matrices are needed only for 6-th order cumulants
5299 IF (wcorr6.gt.0.0d0) THEN
5300 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5301 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5302 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5303 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5304 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5305 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5306 & ADtEAderx(1,1,1,1,1,2))
5307 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5308 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5309 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5310 & ADtEA1derx(1,1,1,1,1,2))
5312 C End 6-th order cumulants
5313 call transpose2(EUgder(1,1,l),auxmat(1,1))
5314 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5315 call transpose2(EUg(1,1,l),auxmat(1,1))
5316 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5317 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5321 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5322 & EAEAderx(1,1,lll,kkk,iii,2))
5327 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5328 C They are needed only when the fifth- or the sixth-order cumulants are
5330 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5331 call transpose2(AEA(1,1,1),auxmat(1,1))
5332 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5333 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5334 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5335 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5336 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5337 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5338 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5339 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5340 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5341 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5342 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5343 call transpose2(AEA(1,1,2),auxmat(1,1))
5344 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5345 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5346 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5347 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5348 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5349 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5350 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5351 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5352 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5353 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5354 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5355 C Calculate the Cartesian derivatives of the vectors.
5359 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5360 call matvec2(auxmat(1,1),b1(1,iti),
5361 & AEAb1derx(1,lll,kkk,iii,1,1))
5362 call matvec2(auxmat(1,1),Ub2(1,i),
5363 & AEAb2derx(1,lll,kkk,iii,1,1))
5364 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5365 & AEAb1derx(1,lll,kkk,iii,2,1))
5366 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5367 & AEAb2derx(1,lll,kkk,iii,2,1))
5368 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5369 call matvec2(auxmat(1,1),b1(1,itj),
5370 & AEAb1derx(1,lll,kkk,iii,1,2))
5371 call matvec2(auxmat(1,1),Ub2(1,j),
5372 & AEAb2derx(1,lll,kkk,iii,1,2))
5373 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5374 & AEAb1derx(1,lll,kkk,iii,2,2))
5375 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5376 & AEAb2derx(1,lll,kkk,iii,2,2))
5383 C Antiparallel orientation of the two CA-CA-CA frames.
5385 iti=itortyp(itype(i))
5389 itk1=itortyp(itype(k+1))
5390 itl=itortyp(itype(l))
5391 itj=itortyp(itype(j))
5392 if (j.lt.nres-1) then
5393 itj1=itortyp(itype(j+1))
5397 C A2 kernel(j-1)T A1T
5398 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5399 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5400 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5401 C Following matrices are needed only for 6-th order cumulants
5402 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5403 & j.eq.i+4 .and. l.eq.i+3)) THEN
5404 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5405 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5406 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5407 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5408 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5409 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5410 & ADtEAderx(1,1,1,1,1,1))
5411 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5412 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5413 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5414 & ADtEA1derx(1,1,1,1,1,1))
5416 C End 6-th order cumulants
5417 call transpose2(EUgder(1,1,k),auxmat(1,1))
5418 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5419 call transpose2(EUg(1,1,k),auxmat(1,1))
5420 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5421 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5425 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5426 & EAEAderx(1,1,lll,kkk,iii,1))
5430 C A2T kernel(i+1)T A1
5431 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5432 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5433 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5434 C Following matrices are needed only for 6-th order cumulants
5435 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5436 & j.eq.i+4 .and. l.eq.i+3)) THEN
5437 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5438 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5439 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5440 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5441 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5442 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5443 & ADtEAderx(1,1,1,1,1,2))
5444 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5445 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5446 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5447 & ADtEA1derx(1,1,1,1,1,2))
5449 C End 6-th order cumulants
5450 call transpose2(EUgder(1,1,j),auxmat(1,1))
5451 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5452 call transpose2(EUg(1,1,j),auxmat(1,1))
5453 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5454 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5458 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5459 & EAEAderx(1,1,lll,kkk,iii,2))
5464 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5465 C They are needed only when the fifth- or the sixth-order cumulants are
5467 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5468 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5469 call transpose2(AEA(1,1,1),auxmat(1,1))
5470 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5471 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5472 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5473 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5474 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5475 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5476 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5477 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5478 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5479 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5480 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5481 call transpose2(AEA(1,1,2),auxmat(1,1))
5482 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5483 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5484 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5485 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5486 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5487 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5488 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5489 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5490 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5491 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5492 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5493 C Calculate the Cartesian derivatives of the vectors.
5497 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5498 call matvec2(auxmat(1,1),b1(1,iti),
5499 & AEAb1derx(1,lll,kkk,iii,1,1))
5500 call matvec2(auxmat(1,1),Ub2(1,i),
5501 & AEAb2derx(1,lll,kkk,iii,1,1))
5502 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5503 & AEAb1derx(1,lll,kkk,iii,2,1))
5504 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5505 & AEAb2derx(1,lll,kkk,iii,2,1))
5506 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5507 call matvec2(auxmat(1,1),b1(1,itl),
5508 & AEAb1derx(1,lll,kkk,iii,1,2))
5509 call matvec2(auxmat(1,1),Ub2(1,l),
5510 & AEAb2derx(1,lll,kkk,iii,1,2))
5511 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5512 & AEAb1derx(1,lll,kkk,iii,2,2))
5513 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5514 & AEAb2derx(1,lll,kkk,iii,2,2))
5523 C---------------------------------------------------------------------------
5524 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5525 & KK,KKderg,AKA,AKAderg,AKAderx)
5529 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5530 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5531 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5536 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5538 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5541 cd if (lprn) write (2,*) 'In kernel'
5543 cd if (lprn) write (2,*) 'kkk=',kkk
5545 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5546 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5548 cd write (2,*) 'lll=',lll
5549 cd write (2,*) 'iii=1'
5551 cd write (2,'(3(2f10.5),5x)')
5552 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5555 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5556 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5558 cd write (2,*) 'lll=',lll
5559 cd write (2,*) 'iii=2'
5561 cd write (2,'(3(2f10.5),5x)')
5562 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5569 C---------------------------------------------------------------------------
5570 double precision function eello4(i,j,k,l,jj,kk)
5571 implicit real*8 (a-h,o-z)
5572 include 'DIMENSIONS'
5573 include 'sizesclu.dat'
5574 include 'COMMON.IOUNITS'
5575 include 'COMMON.CHAIN'
5576 include 'COMMON.DERIV'
5577 include 'COMMON.INTERACT'
5578 include 'COMMON.CONTACTS'
5579 include 'COMMON.TORSION'
5580 include 'COMMON.VAR'
5581 include 'COMMON.GEO'
5582 double precision pizda(2,2),ggg1(3),ggg2(3)
5583 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5587 cd print *,'eello4:',i,j,k,l,jj,kk
5588 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5589 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5590 cold eij=facont_hb(jj,i)
5591 cold ekl=facont_hb(kk,k)
5593 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5595 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5596 gcorr_loc(k-1)=gcorr_loc(k-1)
5597 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5599 gcorr_loc(l-1)=gcorr_loc(l-1)
5600 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5602 gcorr_loc(j-1)=gcorr_loc(j-1)
5603 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5608 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5609 & -EAEAderx(2,2,lll,kkk,iii,1)
5610 cd derx(lll,kkk,iii)=0.0d0
5614 cd gcorr_loc(l-1)=0.0d0
5615 cd gcorr_loc(j-1)=0.0d0
5616 cd gcorr_loc(k-1)=0.0d0
5618 cd write (iout,*)'Contacts have occurred for peptide groups',
5619 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5620 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5621 if (j.lt.nres-1) then
5628 if (l.lt.nres-1) then
5636 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5637 ggg1(ll)=eel4*g_contij(ll,1)
5638 ggg2(ll)=eel4*g_contij(ll,2)
5639 ghalf=0.5d0*ggg1(ll)
5641 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5642 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5643 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5644 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5645 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5646 ghalf=0.5d0*ggg2(ll)
5648 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5649 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5650 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5651 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5656 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5657 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5662 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5663 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5669 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5674 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5678 cd write (2,*) iii,gcorr_loc(iii)
5682 cd write (2,*) 'ekont',ekont
5683 cd write (iout,*) 'eello4',ekont*eel4
5686 C---------------------------------------------------------------------------
5687 double precision function eello5(i,j,k,l,jj,kk)
5688 implicit real*8 (a-h,o-z)
5689 include 'DIMENSIONS'
5690 include 'sizesclu.dat'
5691 include 'COMMON.IOUNITS'
5692 include 'COMMON.CHAIN'
5693 include 'COMMON.DERIV'
5694 include 'COMMON.INTERACT'
5695 include 'COMMON.CONTACTS'
5696 include 'COMMON.TORSION'
5697 include 'COMMON.VAR'
5698 include 'COMMON.GEO'
5699 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5700 double precision ggg1(3),ggg2(3)
5701 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5706 C /l\ / \ \ / \ / \ / C
5707 C / \ / \ \ / \ / \ / C
5708 C j| o |l1 | o | o| o | | o |o C
5709 C \ |/k\| |/ \| / |/ \| |/ \| C
5710 C \i/ \ / \ / / \ / \ C
5712 C (I) (II) (III) (IV) C
5714 C eello5_1 eello5_2 eello5_3 eello5_4 C
5716 C Antiparallel chains C
5719 C /j\ / \ \ / \ / \ / C
5720 C / \ / \ \ / \ / \ / C
5721 C j1| o |l | o | o| o | | o |o C
5722 C \ |/k\| |/ \| / |/ \| |/ \| C
5723 C \i/ \ / \ / / \ / \ C
5725 C (I) (II) (III) (IV) C
5727 C eello5_1 eello5_2 eello5_3 eello5_4 C
5729 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5731 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5732 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5737 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5739 itk=itortyp(itype(k))
5740 itl=itortyp(itype(l))
5741 itj=itortyp(itype(j))
5746 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5747 cd & eel5_3_num,eel5_4_num)
5751 derx(lll,kkk,iii)=0.0d0
5755 cd eij=facont_hb(jj,i)
5756 cd ekl=facont_hb(kk,k)
5758 cd write (iout,*)'Contacts have occurred for peptide groups',
5759 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5761 C Contribution from the graph I.
5762 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5763 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5764 call transpose2(EUg(1,1,k),auxmat(1,1))
5765 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5766 vv(1)=pizda(1,1)-pizda(2,2)
5767 vv(2)=pizda(1,2)+pizda(2,1)
5768 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5769 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5771 C Explicit gradient in virtual-dihedral angles.
5772 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5773 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5774 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5775 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5776 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5777 vv(1)=pizda(1,1)-pizda(2,2)
5778 vv(2)=pizda(1,2)+pizda(2,1)
5779 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5780 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5781 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5782 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5783 vv(1)=pizda(1,1)-pizda(2,2)
5784 vv(2)=pizda(1,2)+pizda(2,1)
5786 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5787 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5788 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5790 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5791 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5792 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5794 C Cartesian gradient
5798 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5800 vv(1)=pizda(1,1)-pizda(2,2)
5801 vv(2)=pizda(1,2)+pizda(2,1)
5802 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5803 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5804 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5811 C Contribution from graph II
5812 call transpose2(EE(1,1,itk),auxmat(1,1))
5813 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5814 vv(1)=pizda(1,1)+pizda(2,2)
5815 vv(2)=pizda(2,1)-pizda(1,2)
5816 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5817 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5819 C Explicit gradient in virtual-dihedral angles.
5820 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5821 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5822 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5823 vv(1)=pizda(1,1)+pizda(2,2)
5824 vv(2)=pizda(2,1)-pizda(1,2)
5826 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5827 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5828 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5830 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5831 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5832 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5834 C Cartesian gradient
5838 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5840 vv(1)=pizda(1,1)+pizda(2,2)
5841 vv(2)=pizda(2,1)-pizda(1,2)
5842 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5843 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5844 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5853 C Parallel orientation
5854 C Contribution from graph III
5855 call transpose2(EUg(1,1,l),auxmat(1,1))
5856 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5857 vv(1)=pizda(1,1)-pizda(2,2)
5858 vv(2)=pizda(1,2)+pizda(2,1)
5859 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5860 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5862 C Explicit gradient in virtual-dihedral angles.
5863 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5864 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5865 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5866 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5867 vv(1)=pizda(1,1)-pizda(2,2)
5868 vv(2)=pizda(1,2)+pizda(2,1)
5869 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5870 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5871 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5872 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5873 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5874 vv(1)=pizda(1,1)-pizda(2,2)
5875 vv(2)=pizda(1,2)+pizda(2,1)
5876 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5877 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5878 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5879 C Cartesian gradient
5883 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5885 vv(1)=pizda(1,1)-pizda(2,2)
5886 vv(2)=pizda(1,2)+pizda(2,1)
5887 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5888 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5889 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5895 C Contribution from graph IV
5897 call transpose2(EE(1,1,itl),auxmat(1,1))
5898 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5899 vv(1)=pizda(1,1)+pizda(2,2)
5900 vv(2)=pizda(2,1)-pizda(1,2)
5901 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5902 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5904 C Explicit gradient in virtual-dihedral angles.
5905 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5906 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5907 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5908 vv(1)=pizda(1,1)+pizda(2,2)
5909 vv(2)=pizda(2,1)-pizda(1,2)
5910 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5911 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5912 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5913 C Cartesian gradient
5917 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5919 vv(1)=pizda(1,1)+pizda(2,2)
5920 vv(2)=pizda(2,1)-pizda(1,2)
5921 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5922 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5923 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5929 C Antiparallel orientation
5930 C Contribution from graph III
5932 call transpose2(EUg(1,1,j),auxmat(1,1))
5933 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5934 vv(1)=pizda(1,1)-pizda(2,2)
5935 vv(2)=pizda(1,2)+pizda(2,1)
5936 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
5937 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5939 C Explicit gradient in virtual-dihedral angles.
5940 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5941 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
5942 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
5943 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5944 vv(1)=pizda(1,1)-pizda(2,2)
5945 vv(2)=pizda(1,2)+pizda(2,1)
5946 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5947 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
5948 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
5949 call transpose2(EUgder(1,1,j),auxmat1(1,1))
5950 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5951 vv(1)=pizda(1,1)-pizda(2,2)
5952 vv(2)=pizda(1,2)+pizda(2,1)
5953 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5954 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
5955 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
5956 C Cartesian gradient
5960 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5962 vv(1)=pizda(1,1)-pizda(2,2)
5963 vv(2)=pizda(1,2)+pizda(2,1)
5964 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
5965 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
5966 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5972 C Contribution from graph IV
5974 call transpose2(EE(1,1,itj),auxmat(1,1))
5975 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5976 vv(1)=pizda(1,1)+pizda(2,2)
5977 vv(2)=pizda(2,1)-pizda(1,2)
5978 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
5979 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
5981 C Explicit gradient in virtual-dihedral angles.
5982 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5983 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
5984 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5985 vv(1)=pizda(1,1)+pizda(2,2)
5986 vv(2)=pizda(2,1)-pizda(1,2)
5987 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5988 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
5989 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
5990 C Cartesian gradient
5994 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5996 vv(1)=pizda(1,1)+pizda(2,2)
5997 vv(2)=pizda(2,1)-pizda(1,2)
5998 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
5999 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6000 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6007 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6008 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6009 cd write (2,*) 'ijkl',i,j,k,l
6010 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6011 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6013 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6014 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6015 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6016 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6018 if (j.lt.nres-1) then
6025 if (l.lt.nres-1) then
6035 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6037 ggg1(ll)=eel5*g_contij(ll,1)
6038 ggg2(ll)=eel5*g_contij(ll,2)
6039 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6040 ghalf=0.5d0*ggg1(ll)
6042 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6043 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6044 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6045 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6046 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6047 ghalf=0.5d0*ggg2(ll)
6049 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6050 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6051 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6052 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6057 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6058 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6063 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6064 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6070 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6075 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6079 cd write (2,*) iii,g_corr5_loc(iii)
6083 cd write (2,*) 'ekont',ekont
6084 cd write (iout,*) 'eello5',ekont*eel5
6087 c--------------------------------------------------------------------------
6088 double precision function eello6(i,j,k,l,jj,kk)
6089 implicit real*8 (a-h,o-z)
6090 include 'DIMENSIONS'
6091 include 'sizesclu.dat'
6092 include 'COMMON.IOUNITS'
6093 include 'COMMON.CHAIN'
6094 include 'COMMON.DERIV'
6095 include 'COMMON.INTERACT'
6096 include 'COMMON.CONTACTS'
6097 include 'COMMON.TORSION'
6098 include 'COMMON.VAR'
6099 include 'COMMON.GEO'
6100 include 'COMMON.FFIELD'
6101 double precision ggg1(3),ggg2(3)
6102 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6107 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6115 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6116 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6120 derx(lll,kkk,iii)=0.0d0
6124 cd eij=facont_hb(jj,i)
6125 cd ekl=facont_hb(kk,k)
6131 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6132 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6133 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6134 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6135 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6136 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6138 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6139 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6140 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6141 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6142 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6143 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6147 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6149 C If turn contributions are considered, they will be handled separately.
6150 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6151 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6152 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6153 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6154 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6155 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6156 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6159 if (j.lt.nres-1) then
6166 if (l.lt.nres-1) then
6174 ggg1(ll)=eel6*g_contij(ll,1)
6175 ggg2(ll)=eel6*g_contij(ll,2)
6176 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6177 ghalf=0.5d0*ggg1(ll)
6179 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6180 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6181 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6182 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6183 ghalf=0.5d0*ggg2(ll)
6184 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6186 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6187 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6188 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6189 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6194 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6195 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6200 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6201 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6207 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6212 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6216 cd write (2,*) iii,g_corr6_loc(iii)
6220 cd write (2,*) 'ekont',ekont
6221 cd write (iout,*) 'eello6',ekont*eel6
6224 c--------------------------------------------------------------------------
6225 double precision function eello6_graph1(i,j,k,l,imat,swap)
6226 implicit real*8 (a-h,o-z)
6227 include 'DIMENSIONS'
6228 include 'sizesclu.dat'
6229 include 'COMMON.IOUNITS'
6230 include 'COMMON.CHAIN'
6231 include 'COMMON.DERIV'
6232 include 'COMMON.INTERACT'
6233 include 'COMMON.CONTACTS'
6234 include 'COMMON.TORSION'
6235 include 'COMMON.VAR'
6236 include 'COMMON.GEO'
6237 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6241 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6243 C Parallel Antiparallel
6249 C \ j|/k\| / \ |/k\|l /
6254 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6255 itk=itortyp(itype(k))
6256 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6257 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6258 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6259 call transpose2(EUgC(1,1,k),auxmat(1,1))
6260 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6261 vv1(1)=pizda1(1,1)-pizda1(2,2)
6262 vv1(2)=pizda1(1,2)+pizda1(2,1)
6263 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6264 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6265 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6266 s5=scalar2(vv(1),Dtobr2(1,i))
6267 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6268 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6269 if (.not. calc_grad) return
6270 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6271 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6272 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6273 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6274 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6275 & +scalar2(vv(1),Dtobr2der(1,i)))
6276 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6277 vv1(1)=pizda1(1,1)-pizda1(2,2)
6278 vv1(2)=pizda1(1,2)+pizda1(2,1)
6279 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6280 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6282 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6283 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6284 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6285 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6286 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6288 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6289 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6290 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6291 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6292 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6294 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6295 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6296 vv1(1)=pizda1(1,1)-pizda1(2,2)
6297 vv1(2)=pizda1(1,2)+pizda1(2,1)
6298 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6299 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6300 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6301 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6310 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6311 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6312 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6313 call transpose2(EUgC(1,1,k),auxmat(1,1))
6314 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6316 vv1(1)=pizda1(1,1)-pizda1(2,2)
6317 vv1(2)=pizda1(1,2)+pizda1(2,1)
6318 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6319 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6320 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6321 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6322 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6323 s5=scalar2(vv(1),Dtobr2(1,i))
6324 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6330 c----------------------------------------------------------------------------
6331 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6332 implicit real*8 (a-h,o-z)
6333 include 'DIMENSIONS'
6334 include 'sizesclu.dat'
6335 include 'COMMON.IOUNITS'
6336 include 'COMMON.CHAIN'
6337 include 'COMMON.DERIV'
6338 include 'COMMON.INTERACT'
6339 include 'COMMON.CONTACTS'
6340 include 'COMMON.TORSION'
6341 include 'COMMON.VAR'
6342 include 'COMMON.GEO'
6344 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6345 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6348 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6350 C Parallel Antiparallel
6361 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6362 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6363 C AL 7/4/01 s1 would occur in the sixth-order moment,
6364 C but not in a cluster cumulant
6366 s1=dip(1,jj,i)*dip(1,kk,k)
6368 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6369 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6370 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6371 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6372 call transpose2(EUg(1,1,k),auxmat(1,1))
6373 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6374 vv(1)=pizda(1,1)-pizda(2,2)
6375 vv(2)=pizda(1,2)+pizda(2,1)
6376 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6377 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6379 eello6_graph2=-(s1+s2+s3+s4)
6381 eello6_graph2=-(s2+s3+s4)
6384 if (.not. calc_grad) return
6385 C Derivatives in gamma(i-1)
6388 s1=dipderg(1,jj,i)*dip(1,kk,k)
6390 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6391 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6392 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6393 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6395 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6397 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6399 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6401 C Derivatives in gamma(k-1)
6403 s1=dip(1,jj,i)*dipderg(1,kk,k)
6405 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6406 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6407 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6408 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6409 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6410 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6411 vv(1)=pizda(1,1)-pizda(2,2)
6412 vv(2)=pizda(1,2)+pizda(2,1)
6413 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6415 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6417 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6419 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6420 C Derivatives in gamma(j-1) or gamma(l-1)
6423 s1=dipderg(3,jj,i)*dip(1,kk,k)
6425 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6426 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6427 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6428 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6429 vv(1)=pizda(1,1)-pizda(2,2)
6430 vv(2)=pizda(1,2)+pizda(2,1)
6431 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6434 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6436 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6439 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6440 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6442 C Derivatives in gamma(l-1) or gamma(j-1)
6445 s1=dip(1,jj,i)*dipderg(3,kk,k)
6447 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6448 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6449 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6450 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6451 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6452 vv(1)=pizda(1,1)-pizda(2,2)
6453 vv(2)=pizda(1,2)+pizda(2,1)
6454 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6457 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6459 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6462 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6463 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6465 C Cartesian derivatives.
6467 write (2,*) 'In eello6_graph2'
6469 write (2,*) 'iii=',iii
6471 write (2,*) 'kkk=',kkk
6473 write (2,'(3(2f10.5),5x)')
6474 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6484 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6486 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6489 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6491 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6492 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6494 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6495 call transpose2(EUg(1,1,k),auxmat(1,1))
6496 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6498 vv(1)=pizda(1,1)-pizda(2,2)
6499 vv(2)=pizda(1,2)+pizda(2,1)
6500 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6501 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6503 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6505 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6508 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6510 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6517 c----------------------------------------------------------------------------
6518 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6519 implicit real*8 (a-h,o-z)
6520 include 'DIMENSIONS'
6521 include 'sizesclu.dat'
6522 include 'COMMON.IOUNITS'
6523 include 'COMMON.CHAIN'
6524 include 'COMMON.DERIV'
6525 include 'COMMON.INTERACT'
6526 include 'COMMON.CONTACTS'
6527 include 'COMMON.TORSION'
6528 include 'COMMON.VAR'
6529 include 'COMMON.GEO'
6530 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6532 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6534 C Parallel Antiparallel
6545 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6547 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6548 C energy moment and not to the cluster cumulant.
6549 iti=itortyp(itype(i))
6550 if (j.lt.nres-1) then
6551 itj1=itortyp(itype(j+1))
6555 itk=itortyp(itype(k))
6556 itk1=itortyp(itype(k+1))
6557 if (l.lt.nres-1) then
6558 itl1=itortyp(itype(l+1))
6563 s1=dip(4,jj,i)*dip(4,kk,k)
6565 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6566 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6567 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6568 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6569 call transpose2(EE(1,1,itk),auxmat(1,1))
6570 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6571 vv(1)=pizda(1,1)+pizda(2,2)
6572 vv(2)=pizda(2,1)-pizda(1,2)
6573 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6574 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6576 eello6_graph3=-(s1+s2+s3+s4)
6578 eello6_graph3=-(s2+s3+s4)
6581 if (.not. calc_grad) return
6582 C Derivatives in gamma(k-1)
6583 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6584 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6585 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6586 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6587 C Derivatives in gamma(l-1)
6588 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6589 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6590 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6591 vv(1)=pizda(1,1)+pizda(2,2)
6592 vv(2)=pizda(2,1)-pizda(1,2)
6593 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6594 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6595 C Cartesian derivatives.
6601 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6603 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6606 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6608 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6609 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6611 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6612 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6614 vv(1)=pizda(1,1)+pizda(2,2)
6615 vv(2)=pizda(2,1)-pizda(1,2)
6616 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6618 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6620 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6623 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6625 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6627 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6633 c----------------------------------------------------------------------------
6634 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6635 implicit real*8 (a-h,o-z)
6636 include 'DIMENSIONS'
6637 include 'sizesclu.dat'
6638 include 'COMMON.IOUNITS'
6639 include 'COMMON.CHAIN'
6640 include 'COMMON.DERIV'
6641 include 'COMMON.INTERACT'
6642 include 'COMMON.CONTACTS'
6643 include 'COMMON.TORSION'
6644 include 'COMMON.VAR'
6645 include 'COMMON.GEO'
6646 include 'COMMON.FFIELD'
6647 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6648 & auxvec1(2),auxmat1(2,2)
6650 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6652 C Parallel Antiparallel
6663 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6665 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6666 C energy moment and not to the cluster cumulant.
6667 cd write (2,*) 'eello_graph4: wturn6',wturn6
6668 iti=itortyp(itype(i))
6669 itj=itortyp(itype(j))
6670 if (j.lt.nres-1) then
6671 itj1=itortyp(itype(j+1))
6675 itk=itortyp(itype(k))
6676 if (k.lt.nres-1) then
6677 itk1=itortyp(itype(k+1))
6681 itl=itortyp(itype(l))
6682 if (l.lt.nres-1) then
6683 itl1=itortyp(itype(l+1))
6687 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6688 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6689 cd & ' itl',itl,' itl1',itl1
6692 s1=dip(3,jj,i)*dip(3,kk,k)
6694 s1=dip(2,jj,j)*dip(2,kk,l)
6697 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6698 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6700 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6701 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6703 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6704 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6706 call transpose2(EUg(1,1,k),auxmat(1,1))
6707 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6708 vv(1)=pizda(1,1)-pizda(2,2)
6709 vv(2)=pizda(2,1)+pizda(1,2)
6710 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6711 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6713 eello6_graph4=-(s1+s2+s3+s4)
6715 eello6_graph4=-(s2+s3+s4)
6717 if (.not. calc_grad) return
6718 C Derivatives in gamma(i-1)
6722 s1=dipderg(2,jj,i)*dip(3,kk,k)
6724 s1=dipderg(4,jj,j)*dip(2,kk,l)
6727 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6729 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6730 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6732 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6733 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6735 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6736 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6737 cd write (2,*) 'turn6 derivatives'
6739 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6741 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6745 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6747 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6751 C Derivatives in gamma(k-1)
6754 s1=dip(3,jj,i)*dipderg(2,kk,k)
6756 s1=dip(2,jj,j)*dipderg(4,kk,l)
6759 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6760 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6762 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6763 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6765 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6766 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6768 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6769 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6770 vv(1)=pizda(1,1)-pizda(2,2)
6771 vv(2)=pizda(2,1)+pizda(1,2)
6772 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6773 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6775 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6777 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6781 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6783 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6786 C Derivatives in gamma(j-1) or gamma(l-1)
6787 if (l.eq.j+1 .and. l.gt.1) then
6788 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6789 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6790 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6791 vv(1)=pizda(1,1)-pizda(2,2)
6792 vv(2)=pizda(2,1)+pizda(1,2)
6793 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6794 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6795 else if (j.gt.1) then
6796 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6797 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6798 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6799 vv(1)=pizda(1,1)-pizda(2,2)
6800 vv(2)=pizda(2,1)+pizda(1,2)
6801 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6802 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6803 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6805 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6808 C Cartesian derivatives.
6815 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6817 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6821 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6823 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6827 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6829 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6831 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6832 & b1(1,itj1),auxvec(1))
6833 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6835 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6836 & b1(1,itl1),auxvec(1))
6837 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6839 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6841 vv(1)=pizda(1,1)-pizda(2,2)
6842 vv(2)=pizda(2,1)+pizda(1,2)
6843 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6845 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6847 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6850 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6853 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6856 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6858 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6860 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6864 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6866 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6869 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6871 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6879 c----------------------------------------------------------------------------
6880 double precision function eello_turn6(i,jj,kk)
6881 implicit real*8 (a-h,o-z)
6882 include 'DIMENSIONS'
6883 include 'sizesclu.dat'
6884 include 'COMMON.IOUNITS'
6885 include 'COMMON.CHAIN'
6886 include 'COMMON.DERIV'
6887 include 'COMMON.INTERACT'
6888 include 'COMMON.CONTACTS'
6889 include 'COMMON.TORSION'
6890 include 'COMMON.VAR'
6891 include 'COMMON.GEO'
6892 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6893 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6895 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6896 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6897 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6898 C the respective energy moment and not to the cluster cumulant.
6903 iti=itortyp(itype(i))
6904 itk=itortyp(itype(k))
6905 itk1=itortyp(itype(k+1))
6906 itl=itortyp(itype(l))
6907 itj=itortyp(itype(j))
6908 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6909 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6910 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6915 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6917 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6921 derx_turn(lll,kkk,iii)=0.0d0
6928 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6930 cd write (2,*) 'eello6_5',eello6_5
6932 call transpose2(AEA(1,1,1),auxmat(1,1))
6933 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
6934 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
6935 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
6939 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
6940 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
6941 s2 = scalar2(b1(1,itk),vtemp1(1))
6943 call transpose2(AEA(1,1,2),atemp(1,1))
6944 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
6945 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
6946 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
6950 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
6951 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
6952 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
6954 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
6955 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
6956 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
6957 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
6958 ss13 = scalar2(b1(1,itk),vtemp4(1))
6959 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
6963 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
6969 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
6971 C Derivatives in gamma(i+2)
6973 call transpose2(AEA(1,1,1),auxmatd(1,1))
6974 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
6975 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
6976 call transpose2(AEAderg(1,1,2),atempd(1,1))
6977 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
6978 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
6982 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
6983 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
6984 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
6990 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
6991 C Derivatives in gamma(i+3)
6993 call transpose2(AEA(1,1,1),auxmatd(1,1))
6994 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
6995 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
6996 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7000 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7001 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7002 s2d = scalar2(b1(1,itk),vtemp1d(1))
7004 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7005 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7007 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7009 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7010 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7011 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7021 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7022 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7024 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7025 & -0.5d0*ekont*(s2d+s12d)
7027 C Derivatives in gamma(i+4)
7028 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7029 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7030 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7032 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7033 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7034 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7044 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7046 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7048 C Derivatives in gamma(i+5)
7050 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7051 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7052 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7056 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7057 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7058 s2d = scalar2(b1(1,itk),vtemp1d(1))
7060 call transpose2(AEA(1,1,2),atempd(1,1))
7061 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7062 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7066 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7067 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7069 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7070 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7071 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7081 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7082 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7084 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7085 & -0.5d0*ekont*(s2d+s12d)
7087 C Cartesian derivatives
7092 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7093 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7094 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7098 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7099 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7101 s2d = scalar2(b1(1,itk),vtemp1d(1))
7103 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7104 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7105 s8d = -(atempd(1,1)+atempd(2,2))*
7106 & scalar2(cc(1,1,itl),vtemp2(1))
7110 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7112 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7113 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7120 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7123 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7127 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7128 & - 0.5d0*(s8d+s12d)
7130 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7139 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7141 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7142 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7143 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7144 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7145 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7147 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7148 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7149 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7153 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7154 cd & 16*eel_turn6_num
7156 if (j.lt.nres-1) then
7163 if (l.lt.nres-1) then
7171 ggg1(ll)=eel_turn6*g_contij(ll,1)
7172 ggg2(ll)=eel_turn6*g_contij(ll,2)
7173 ghalf=0.5d0*ggg1(ll)
7175 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7176 & +ekont*derx_turn(ll,2,1)
7177 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7178 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7179 & +ekont*derx_turn(ll,4,1)
7180 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7181 ghalf=0.5d0*ggg2(ll)
7183 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7184 & +ekont*derx_turn(ll,2,2)
7185 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7186 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7187 & +ekont*derx_turn(ll,4,2)
7188 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7193 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7198 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7204 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7209 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7213 cd write (2,*) iii,g_corr6_loc(iii)
7216 eello_turn6=ekont*eel_turn6
7217 cd write (2,*) 'ekont',ekont
7218 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7221 crc-------------------------------------------------
7222 SUBROUTINE MATVEC2(A1,V1,V2)
7223 implicit real*8 (a-h,o-z)
7224 include 'DIMENSIONS'
7225 DIMENSION A1(2,2),V1(2),V2(2)
7229 c 3 VI=VI+A1(I,K)*V1(K)
7233 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7234 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7239 C---------------------------------------
7240 SUBROUTINE MATMAT2(A1,A2,A3)
7241 implicit real*8 (a-h,o-z)
7242 include 'DIMENSIONS'
7243 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7244 c DIMENSION AI3(2,2)
7248 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7254 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7255 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7256 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7257 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7265 c-------------------------------------------------------------------------
7266 double precision function scalar2(u,v)
7268 double precision u(2),v(2)
7271 scalar2=u(1)*v(1)+u(2)*v(2)
7275 C-----------------------------------------------------------------------------
7277 subroutine transpose2(a,at)
7279 double precision a(2,2),at(2,2)
7286 c--------------------------------------------------------------------------
7287 subroutine transpose(n,a,at)
7290 double precision a(n,n),at(n,n)
7298 C---------------------------------------------------------------------------
7299 subroutine prodmat3(a1,a2,kk,transp,prod)
7302 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7304 crc double precision auxmat(2,2),prod_(2,2)
7307 crc call transpose2(kk(1,1),auxmat(1,1))
7308 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7309 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7311 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7312 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7313 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7314 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7315 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7316 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7317 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7318 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7321 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7322 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7324 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7325 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7326 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7327 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7328 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7329 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7330 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7331 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7334 c call transpose2(a2(1,1),a2t(1,1))
7337 crc print *,((prod_(i,j),i=1,2),j=1,2)
7338 crc print *,((prod(i,j),i=1,2),j=1,2)
7342 C-----------------------------------------------------------------------------
7343 double precision function scalar(u,v)
7345 double precision u(3),v(3)