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 c 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 c 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 c 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 c 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 c include "DIMENSIONS.COMPAR"
850 include 'COMMON.LOCAL'
851 include 'COMMON.CHAIN'
852 include 'COMMON.DERIV'
853 include 'COMMON.NAMES'
854 include 'COMMON.INTERACT'
855 include 'COMMON.IOUNITS'
856 include 'COMMON.CALC'
862 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
865 c if (icall.gt.0) lprn=.true.
873 dxi=dc_norm(1,nres+i)
874 dyi=dc_norm(2,nres+i)
875 dzi=dc_norm(3,nres+i)
876 dsci_inv=vbld_inv(i+nres)
878 C Calculate SC interaction energy.
881 do j=istart(i,iint),iend(i,iint)
884 dscj_inv=vbld_inv(j+nres)
885 sig0ij=sigma(itypi,itypj)
887 chi1=chi(itypi,itypj)
888 chi2=chi(itypj,itypi)
895 alf12=0.5D0*(alf1+alf2)
896 C For diagnostics only!!!
909 dxj=dc_norm(1,nres+j)
910 dyj=dc_norm(2,nres+j)
911 dzj=dc_norm(3,nres+j)
912 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
914 C Calculate angle-dependent terms of energy and contributions to their
918 sig=sig0ij*dsqrt(sigsq)
919 rij_shift=1.0D0/rij-sig+r0ij
920 C I hate to put IF's in the loops, but here don't have another choice!!!!
921 if (rij_shift.le.0.0D0) then
926 c---------------------------------------------------------------
927 rij_shift=1.0D0/rij_shift
929 e1=fac*fac*aa(itypi,itypj)
930 e2=fac*bb(itypi,itypj)
931 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
932 eps2der=evdwij*eps3rt
933 eps3der=evdwij*eps2rt
935 e_augm=augm(itypi,itypj)*fac_augm
936 evdwij=evdwij*eps2rt*eps3rt
937 evdw=evdw+evdwij+e_augm
938 ij=icant(itypi,itypj)
939 aux=eps1*eps2rt**2*eps3rt**2
941 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
942 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
943 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
944 c & restyp(itypi),i,restyp(itypj),j,
945 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
946 c & chi1,chi2,chip1,chip2,
947 c & eps1,eps2rt**2,eps3rt**2,
948 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
952 C Calculate gradient components.
953 e1=e1*eps1*eps2rt**2*eps3rt**2
954 fac=-expon*(e1+evdwij)*rij_shift
956 fac=rij*fac-2*expon*rrij*e_augm
957 C Calculate the radial part of the gradient
961 C Calculate angular part of the gradient.
969 C-----------------------------------------------------------------------------
970 subroutine sc_angular
971 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
972 C om12. Called by ebp, egb, and egbv.
974 include 'COMMON.CALC'
978 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
979 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
980 om12=dxi*dxj+dyi*dyj+dzi*dzj
982 C Calculate eps1(om12) and its derivative in om12
983 faceps1=1.0D0-om12*chiom12
984 faceps1_inv=1.0D0/faceps1
985 eps1=dsqrt(faceps1_inv)
986 C Following variable is eps1*deps1/dom12
987 eps1_om12=faceps1_inv*chiom12
988 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
993 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
994 sigsq=1.0D0-facsig*faceps1_inv
995 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
996 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
997 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
998 C Calculate eps2 and its derivatives in om1, om2, and om12.
1001 chipom12=chip12*om12
1002 facp=1.0D0-om12*chipom12
1004 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1005 C Following variable is the square root of eps2
1006 eps2rt=1.0D0-facp1*facp_inv
1007 C Following three variables are the derivatives of the square root of eps
1008 C in om1, om2, and om12.
1009 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1010 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1011 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1012 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1013 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1014 C Calculate whole angle-dependent part of epsilon and contributions
1015 C to its derivatives
1018 C----------------------------------------------------------------------------
1020 implicit real*8 (a-h,o-z)
1021 include 'DIMENSIONS'
1022 include 'sizesclu.dat'
1023 include 'COMMON.CHAIN'
1024 include 'COMMON.DERIV'
1025 include 'COMMON.CALC'
1026 double precision dcosom1(3),dcosom2(3)
1027 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1028 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1029 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1030 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1032 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1033 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1036 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1039 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1040 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1041 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1042 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1043 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1044 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1047 C Calculate the components of the gradient in DC and X
1051 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1056 c------------------------------------------------------------------------------
1057 subroutine vec_and_deriv
1058 implicit real*8 (a-h,o-z)
1059 include 'DIMENSIONS'
1060 include 'sizesclu.dat'
1061 include 'COMMON.IOUNITS'
1062 include 'COMMON.GEO'
1063 include 'COMMON.VAR'
1064 include 'COMMON.LOCAL'
1065 include 'COMMON.CHAIN'
1066 include 'COMMON.VECTORS'
1067 include 'COMMON.DERIV'
1068 include 'COMMON.INTERACT'
1069 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1070 C Compute the local reference systems. For reference system (i), the
1071 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1072 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1074 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1075 if (i.eq.nres-1) then
1076 C Case of the last full residue
1077 C Compute the Z-axis
1078 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1079 costh=dcos(pi-theta(nres))
1080 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1085 C Compute the derivatives of uz
1087 uzder(2,1,1)=-dc_norm(3,i-1)
1088 uzder(3,1,1)= dc_norm(2,i-1)
1089 uzder(1,2,1)= dc_norm(3,i-1)
1091 uzder(3,2,1)=-dc_norm(1,i-1)
1092 uzder(1,3,1)=-dc_norm(2,i-1)
1093 uzder(2,3,1)= dc_norm(1,i-1)
1096 uzder(2,1,2)= dc_norm(3,i)
1097 uzder(3,1,2)=-dc_norm(2,i)
1098 uzder(1,2,2)=-dc_norm(3,i)
1100 uzder(3,2,2)= dc_norm(1,i)
1101 uzder(1,3,2)= dc_norm(2,i)
1102 uzder(2,3,2)=-dc_norm(1,i)
1105 C Compute the Y-axis
1108 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1111 C Compute the derivatives of uy
1114 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1115 & -dc_norm(k,i)*dc_norm(j,i-1)
1116 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1118 uyder(j,j,1)=uyder(j,j,1)-costh
1119 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1124 uygrad(l,k,j,i)=uyder(l,k,j)
1125 uzgrad(l,k,j,i)=uzder(l,k,j)
1129 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1130 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1131 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1132 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1136 C Compute the Z-axis
1137 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1138 costh=dcos(pi-theta(i+2))
1139 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1144 C Compute the derivatives of uz
1146 uzder(2,1,1)=-dc_norm(3,i+1)
1147 uzder(3,1,1)= dc_norm(2,i+1)
1148 uzder(1,2,1)= dc_norm(3,i+1)
1150 uzder(3,2,1)=-dc_norm(1,i+1)
1151 uzder(1,3,1)=-dc_norm(2,i+1)
1152 uzder(2,3,1)= dc_norm(1,i+1)
1155 uzder(2,1,2)= dc_norm(3,i)
1156 uzder(3,1,2)=-dc_norm(2,i)
1157 uzder(1,2,2)=-dc_norm(3,i)
1159 uzder(3,2,2)= dc_norm(1,i)
1160 uzder(1,3,2)= dc_norm(2,i)
1161 uzder(2,3,2)=-dc_norm(1,i)
1164 C Compute the Y-axis
1167 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1170 C Compute the derivatives of uy
1173 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1174 & -dc_norm(k,i)*dc_norm(j,i+1)
1175 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1177 uyder(j,j,1)=uyder(j,j,1)-costh
1178 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1183 uygrad(l,k,j,i)=uyder(l,k,j)
1184 uzgrad(l,k,j,i)=uzder(l,k,j)
1188 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1189 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1190 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1191 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1197 vbld_inv_temp(1)=vbld_inv(i+1)
1198 if (i.lt.nres-1) then
1199 vbld_inv_temp(2)=vbld_inv(i+2)
1201 vbld_inv_temp(2)=vbld_inv(i)
1206 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1207 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1215 C-----------------------------------------------------------------------------
1216 subroutine vec_and_deriv_test
1217 implicit real*8 (a-h,o-z)
1218 include 'DIMENSIONS'
1219 include 'sizesclu.dat'
1220 include 'COMMON.IOUNITS'
1221 include 'COMMON.GEO'
1222 include 'COMMON.VAR'
1223 include 'COMMON.LOCAL'
1224 include 'COMMON.CHAIN'
1225 include 'COMMON.VECTORS'
1226 dimension uyder(3,3,2),uzder(3,3,2)
1227 C Compute the local reference systems. For reference system (i), the
1228 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1229 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1231 if (i.eq.nres-1) then
1232 C Case of the last full residue
1233 C Compute the Z-axis
1234 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1235 costh=dcos(pi-theta(nres))
1236 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1237 c write (iout,*) 'fac',fac,
1238 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1239 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1243 C Compute the derivatives of uz
1245 uzder(2,1,1)=-dc_norm(3,i-1)
1246 uzder(3,1,1)= dc_norm(2,i-1)
1247 uzder(1,2,1)= dc_norm(3,i-1)
1249 uzder(3,2,1)=-dc_norm(1,i-1)
1250 uzder(1,3,1)=-dc_norm(2,i-1)
1251 uzder(2,3,1)= dc_norm(1,i-1)
1254 uzder(2,1,2)= dc_norm(3,i)
1255 uzder(3,1,2)=-dc_norm(2,i)
1256 uzder(1,2,2)=-dc_norm(3,i)
1258 uzder(3,2,2)= dc_norm(1,i)
1259 uzder(1,3,2)= dc_norm(2,i)
1260 uzder(2,3,2)=-dc_norm(1,i)
1262 C Compute the Y-axis
1264 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1267 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1268 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1269 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1271 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1274 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1275 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1278 c write (iout,*) 'facy',facy,
1279 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1280 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1282 uy(k,i)=facy*uy(k,i)
1284 C Compute the derivatives of uy
1287 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1288 & -dc_norm(k,i)*dc_norm(j,i-1)
1289 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1291 c uyder(j,j,1)=uyder(j,j,1)-costh
1292 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1293 uyder(j,j,1)=uyder(j,j,1)
1294 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1295 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1301 uygrad(l,k,j,i)=uyder(l,k,j)
1302 uzgrad(l,k,j,i)=uzder(l,k,j)
1306 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1307 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1308 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1309 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1312 C Compute the Z-axis
1313 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1314 costh=dcos(pi-theta(i+2))
1315 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1316 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1320 C Compute the derivatives of uz
1322 uzder(2,1,1)=-dc_norm(3,i+1)
1323 uzder(3,1,1)= dc_norm(2,i+1)
1324 uzder(1,2,1)= dc_norm(3,i+1)
1326 uzder(3,2,1)=-dc_norm(1,i+1)
1327 uzder(1,3,1)=-dc_norm(2,i+1)
1328 uzder(2,3,1)= dc_norm(1,i+1)
1331 uzder(2,1,2)= dc_norm(3,i)
1332 uzder(3,1,2)=-dc_norm(2,i)
1333 uzder(1,2,2)=-dc_norm(3,i)
1335 uzder(3,2,2)= dc_norm(1,i)
1336 uzder(1,3,2)= dc_norm(2,i)
1337 uzder(2,3,2)=-dc_norm(1,i)
1339 C Compute the Y-axis
1341 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1342 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1343 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1345 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1348 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1349 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1352 c write (iout,*) 'facy',facy,
1353 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1354 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1356 uy(k,i)=facy*uy(k,i)
1358 C Compute the derivatives of uy
1361 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1362 & -dc_norm(k,i)*dc_norm(j,i+1)
1363 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1365 c uyder(j,j,1)=uyder(j,j,1)-costh
1366 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1367 uyder(j,j,1)=uyder(j,j,1)
1368 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1369 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1375 uygrad(l,k,j,i)=uyder(l,k,j)
1376 uzgrad(l,k,j,i)=uzder(l,k,j)
1380 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1381 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1382 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1383 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1390 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1391 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1398 C-----------------------------------------------------------------------------
1399 subroutine check_vecgrad
1400 implicit real*8 (a-h,o-z)
1401 include 'DIMENSIONS'
1402 include 'sizesclu.dat'
1403 include 'COMMON.IOUNITS'
1404 include 'COMMON.GEO'
1405 include 'COMMON.VAR'
1406 include 'COMMON.LOCAL'
1407 include 'COMMON.CHAIN'
1408 include 'COMMON.VECTORS'
1409 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1410 dimension uyt(3,maxres),uzt(3,maxres)
1411 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1412 double precision delta /1.0d-7/
1415 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1416 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1417 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1418 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1419 cd & (dc_norm(if90,i),if90=1,3)
1420 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1421 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1422 cd write(iout,'(a)')
1428 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1429 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1442 cd write (iout,*) 'i=',i
1444 erij(k)=dc_norm(k,i)
1448 dc_norm(k,i)=erij(k)
1450 dc_norm(j,i)=dc_norm(j,i)+delta
1451 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1453 c dc_norm(k,i)=dc_norm(k,i)/fac
1455 c write (iout,*) (dc_norm(k,i),k=1,3)
1456 c write (iout,*) (erij(k),k=1,3)
1459 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1460 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1461 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1462 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1464 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1465 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1466 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1469 dc_norm(k,i)=erij(k)
1472 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1473 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1474 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1475 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1476 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1477 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1478 cd write (iout,'(a)')
1483 C--------------------------------------------------------------------------
1484 subroutine set_matrices
1485 implicit real*8 (a-h,o-z)
1486 include 'DIMENSIONS'
1487 include 'sizesclu.dat'
1488 include 'COMMON.IOUNITS'
1489 include 'COMMON.GEO'
1490 include 'COMMON.VAR'
1491 include 'COMMON.LOCAL'
1492 include 'COMMON.CHAIN'
1493 include 'COMMON.DERIV'
1494 include 'COMMON.INTERACT'
1495 include 'COMMON.CONTACTS'
1496 include 'COMMON.TORSION'
1497 include 'COMMON.VECTORS'
1498 include 'COMMON.FFIELD'
1499 double precision auxvec(2),auxmat(2,2)
1501 C Compute the virtual-bond-torsional-angle dependent quantities needed
1502 C to calculate the el-loc multibody terms of various order.
1505 if (i .lt. nres+1) then
1542 if (i .gt. 3 .and. i .lt. nres+1) then
1543 obrot_der(1,i-2)=-sin1
1544 obrot_der(2,i-2)= cos1
1545 Ugder(1,1,i-2)= sin1
1546 Ugder(1,2,i-2)=-cos1
1547 Ugder(2,1,i-2)=-cos1
1548 Ugder(2,2,i-2)=-sin1
1551 obrot2_der(1,i-2)=-dwasin2
1552 obrot2_der(2,i-2)= dwacos2
1553 Ug2der(1,1,i-2)= dwasin2
1554 Ug2der(1,2,i-2)=-dwacos2
1555 Ug2der(2,1,i-2)=-dwacos2
1556 Ug2der(2,2,i-2)=-dwasin2
1558 obrot_der(1,i-2)=0.0d0
1559 obrot_der(2,i-2)=0.0d0
1560 Ugder(1,1,i-2)=0.0d0
1561 Ugder(1,2,i-2)=0.0d0
1562 Ugder(2,1,i-2)=0.0d0
1563 Ugder(2,2,i-2)=0.0d0
1564 obrot2_der(1,i-2)=0.0d0
1565 obrot2_der(2,i-2)=0.0d0
1566 Ug2der(1,1,i-2)=0.0d0
1567 Ug2der(1,2,i-2)=0.0d0
1568 Ug2der(2,1,i-2)=0.0d0
1569 Ug2der(2,2,i-2)=0.0d0
1571 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1572 iti = itortyp(itype(i-2))
1576 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1577 iti1 = itortyp(itype(i-1))
1581 cd write (iout,*) '*******i',i,' iti1',iti
1582 cd write (iout,*) 'b1',b1(:,iti)
1583 cd write (iout,*) 'b2',b2(:,iti)
1584 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1585 if (i .gt. iatel_s+2) then
1586 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1587 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1588 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1589 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1590 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1591 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1592 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1602 DtUg2(l,k,i-2)=0.0d0
1606 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1607 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1608 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1609 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1610 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1611 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1612 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1614 muder(k,i-2)=Ub2der(k,i-2)
1616 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1617 iti1 = itortyp(itype(i-1))
1622 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1624 C Vectors and matrices dependent on a single virtual-bond dihedral.
1625 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1626 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1627 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1628 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1629 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1630 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1631 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1632 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1633 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1634 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1635 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1637 C Matrices dependent on two consecutive virtual-bond dihedrals.
1638 C The order of matrices is from left to right.
1640 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1641 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1642 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1643 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1644 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1645 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1646 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1647 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1650 cd iti = itortyp(itype(i))
1653 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1654 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1659 C--------------------------------------------------------------------------
1660 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1662 C This subroutine calculates the average interaction energy and its gradient
1663 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1664 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1665 C The potential depends both on the distance of peptide-group centers and on
1666 C the orientation of the CA-CA virtual bonds.
1668 implicit real*8 (a-h,o-z)
1669 include 'DIMENSIONS'
1670 include 'sizesclu.dat'
1671 include 'COMMON.CONTROL'
1672 include 'COMMON.IOUNITS'
1673 include 'COMMON.GEO'
1674 include 'COMMON.VAR'
1675 include 'COMMON.LOCAL'
1676 include 'COMMON.CHAIN'
1677 include 'COMMON.DERIV'
1678 include 'COMMON.INTERACT'
1679 include 'COMMON.CONTACTS'
1680 include 'COMMON.TORSION'
1681 include 'COMMON.VECTORS'
1682 include 'COMMON.FFIELD'
1683 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1684 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1685 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1686 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1687 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1688 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1689 double precision scal_el /0.5d0/
1691 C 13-go grudnia roku pamietnego...
1692 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1693 & 0.0d0,1.0d0,0.0d0,
1694 & 0.0d0,0.0d0,1.0d0/
1695 cd write(iout,*) 'In EELEC'
1697 cd write(iout,*) 'Type',i
1698 cd write(iout,*) 'B1',B1(:,i)
1699 cd write(iout,*) 'B2',B2(:,i)
1700 cd write(iout,*) 'CC',CC(:,:,i)
1701 cd write(iout,*) 'DD',DD(:,:,i)
1702 cd write(iout,*) 'EE',EE(:,:,i)
1704 cd call check_vecgrad
1706 if (icheckgrad.eq.1) then
1708 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1710 dc_norm(k,i)=dc(k,i)*fac
1712 c write (iout,*) 'i',i,' fac',fac
1715 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1716 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1717 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1718 cd if (wel_loc.gt.0.0d0) then
1719 if (icheckgrad.eq.1) then
1720 call vec_and_deriv_test
1727 cd write (iout,*) 'i=',i
1729 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1732 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1733 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1746 cd print '(a)','Enter EELEC'
1747 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1749 gel_loc_loc(i)=0.0d0
1752 do i=iatel_s,iatel_e
1753 if (itel(i).eq.0) goto 1215
1757 dx_normi=dc_norm(1,i)
1758 dy_normi=dc_norm(2,i)
1759 dz_normi=dc_norm(3,i)
1760 xmedi=c(1,i)+0.5d0*dxi
1761 ymedi=c(2,i)+0.5d0*dyi
1762 zmedi=c(3,i)+0.5d0*dzi
1764 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1765 do j=ielstart(i),ielend(i)
1766 if (itel(j).eq.0) goto 1216
1770 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1771 aaa=app(iteli,itelj)
1772 bbb=bpp(iteli,itelj)
1773 C Diagnostics only!!!
1779 ael6i=ael6(iteli,itelj)
1780 ael3i=ael3(iteli,itelj)
1784 dx_normj=dc_norm(1,j)
1785 dy_normj=dc_norm(2,j)
1786 dz_normj=dc_norm(3,j)
1787 xj=c(1,j)+0.5D0*dxj-xmedi
1788 yj=c(2,j)+0.5D0*dyj-ymedi
1789 zj=c(3,j)+0.5D0*dzj-zmedi
1790 rij=xj*xj+yj*yj+zj*zj
1796 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1797 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1798 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1799 fac=cosa-3.0D0*cosb*cosg
1801 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1802 if (j.eq.i+2) ev1=scal_el*ev1
1807 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1810 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1811 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1812 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1815 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1816 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1817 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1818 cd & xmedi,ymedi,zmedi,xj,yj,zj
1820 C Calculate contributions to the Cartesian gradient.
1823 facvdw=-6*rrmij*(ev1+evdwij)
1824 facel=-3*rrmij*(el1+eesij)
1831 * Radial derivatives. First process both termini of the fragment (i,j)
1838 gelc(k,i)=gelc(k,i)+ghalf
1839 gelc(k,j)=gelc(k,j)+ghalf
1842 * Loop over residues i+1 thru j-1.
1846 gelc(l,k)=gelc(l,k)+ggg(l)
1854 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1855 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1858 * Loop over residues i+1 thru j-1.
1862 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1869 fac=-3*rrmij*(facvdw+facvdw+facel)
1875 * Radial derivatives. First process both termini of the fragment (i,j)
1882 gelc(k,i)=gelc(k,i)+ghalf
1883 gelc(k,j)=gelc(k,j)+ghalf
1886 * Loop over residues i+1 thru j-1.
1890 gelc(l,k)=gelc(l,k)+ggg(l)
1897 ecosa=2.0D0*fac3*fac1+fac4
1900 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1901 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1903 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1904 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1906 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1907 cd & (dcosg(k),k=1,3)
1909 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1913 gelc(k,i)=gelc(k,i)+ghalf
1914 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1915 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1916 gelc(k,j)=gelc(k,j)+ghalf
1917 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1918 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1922 gelc(l,k)=gelc(l,k)+ggg(l)
1927 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1928 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
1929 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
1931 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
1932 C energy of a peptide unit is assumed in the form of a second-order
1933 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
1934 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
1935 C are computed for EVERY pair of non-contiguous peptide groups.
1937 if (j.lt.nres-1) then
1948 muij(kkk)=mu(k,i)*mu(l,j)
1951 cd write (iout,*) 'EELEC: i',i,' j',j
1952 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
1953 cd write(iout,*) 'muij',muij
1954 ury=scalar(uy(1,i),erij)
1955 urz=scalar(uz(1,i),erij)
1956 vry=scalar(uy(1,j),erij)
1957 vrz=scalar(uz(1,j),erij)
1958 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
1959 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
1960 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
1961 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
1962 C For diagnostics only
1967 fac=dsqrt(-ael6i)*r3ij
1968 cd write (2,*) 'fac=',fac
1969 C For diagnostics only
1975 cd write (iout,'(4i5,4f10.5)')
1976 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
1977 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
1978 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
1979 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
1980 cd write (iout,'(4f10.5)')
1981 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
1982 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
1983 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
1984 cd write (iout,'(2i3,9f10.5/)') i,j,
1985 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
1987 C Derivatives of the elements of A in virtual-bond vectors
1988 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
1995 uryg(k,1)=scalar(erder(1,k),uy(1,i))
1996 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
1997 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
1998 urzg(k,1)=scalar(erder(1,k),uz(1,i))
1999 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2000 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2001 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2002 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2003 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2004 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2005 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2006 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2016 C Compute radial contributions to the gradient
2038 C Add the contributions coming from er
2041 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2042 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2043 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2044 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2047 C Derivatives in DC(i)
2048 ghalf1=0.5d0*agg(k,1)
2049 ghalf2=0.5d0*agg(k,2)
2050 ghalf3=0.5d0*agg(k,3)
2051 ghalf4=0.5d0*agg(k,4)
2052 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2053 & -3.0d0*uryg(k,2)*vry)+ghalf1
2054 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2055 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2056 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2057 & -3.0d0*urzg(k,2)*vry)+ghalf3
2058 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2059 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2060 C Derivatives in DC(i+1)
2061 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2062 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2063 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2064 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2065 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2066 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2067 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2068 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2069 C Derivatives in DC(j)
2070 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2071 & -3.0d0*vryg(k,2)*ury)+ghalf1
2072 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2073 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2074 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2075 & -3.0d0*vryg(k,2)*urz)+ghalf3
2076 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2077 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2078 C Derivatives in DC(j+1) or DC(nres-1)
2079 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2080 & -3.0d0*vryg(k,3)*ury)
2081 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2082 & -3.0d0*vrzg(k,3)*ury)
2083 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2084 & -3.0d0*vryg(k,3)*urz)
2085 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2086 & -3.0d0*vrzg(k,3)*urz)
2091 C Derivatives in DC(i+1)
2092 cd aggi1(k,1)=agg(k,1)
2093 cd aggi1(k,2)=agg(k,2)
2094 cd aggi1(k,3)=agg(k,3)
2095 cd aggi1(k,4)=agg(k,4)
2096 C Derivatives in DC(j)
2101 C Derivatives in DC(j+1)
2106 if (j.eq.nres-1 .and. i.lt.j-2) then
2108 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2109 cd aggj1(k,l)=agg(k,l)
2115 C Check the loc-el terms by numerical integration
2125 aggi(k,l)=-aggi(k,l)
2126 aggi1(k,l)=-aggi1(k,l)
2127 aggj(k,l)=-aggj(k,l)
2128 aggj1(k,l)=-aggj1(k,l)
2131 if (j.lt.nres-1) then
2137 aggi(k,l)=-aggi(k,l)
2138 aggi1(k,l)=-aggi1(k,l)
2139 aggj(k,l)=-aggj(k,l)
2140 aggj1(k,l)=-aggj1(k,l)
2151 aggi(k,l)=-aggi(k,l)
2152 aggi1(k,l)=-aggi1(k,l)
2153 aggj(k,l)=-aggj(k,l)
2154 aggj1(k,l)=-aggj1(k,l)
2160 IF (wel_loc.gt.0.0d0) THEN
2161 C Contribution to the local-electrostatic energy coming from the i-j pair
2162 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2164 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2165 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2166 eel_loc=eel_loc+eel_loc_ij
2167 C Partial derivatives in virtual-bond dihedral angles gamma
2170 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2171 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2172 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2173 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2174 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2175 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2176 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2177 cd write(iout,*) 'agg ',agg
2178 cd write(iout,*) 'aggi ',aggi
2179 cd write(iout,*) 'aggi1',aggi1
2180 cd write(iout,*) 'aggj ',aggj
2181 cd write(iout,*) 'aggj1',aggj1
2183 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2185 ggg(l)=agg(l,1)*muij(1)+
2186 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2190 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2193 C Remaining derivatives of eello
2195 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2196 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2197 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2198 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2199 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2200 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2201 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2202 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2206 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2207 C Contributions from turns
2212 call eturn34(i,j,eello_turn3,eello_turn4)
2214 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2215 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2217 C Calculate the contact function. The ith column of the array JCONT will
2218 C contain the numbers of atoms that make contacts with the atom I (of numbers
2219 C greater than I). The arrays FACONT and GACONT will contain the values of
2220 C the contact function and its derivative.
2221 c r0ij=1.02D0*rpp(iteli,itelj)
2222 c r0ij=1.11D0*rpp(iteli,itelj)
2223 r0ij=2.20D0*rpp(iteli,itelj)
2224 c r0ij=1.55D0*rpp(iteli,itelj)
2225 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2226 if (fcont.gt.0.0D0) then
2227 num_conti=num_conti+1
2228 if (num_conti.gt.maxconts) then
2229 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2230 & ' will skip next contacts for this conf.'
2232 jcont_hb(num_conti,i)=j
2233 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2234 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2235 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2237 d_cont(num_conti,i)=rij
2238 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2239 C --- Electrostatic-interaction matrix ---
2240 a_chuj(1,1,num_conti,i)=a22
2241 a_chuj(1,2,num_conti,i)=a23
2242 a_chuj(2,1,num_conti,i)=a32
2243 a_chuj(2,2,num_conti,i)=a33
2244 C --- Gradient of rij
2246 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2249 c a_chuj(1,1,num_conti,i)=-0.61d0
2250 c a_chuj(1,2,num_conti,i)= 0.4d0
2251 c a_chuj(2,1,num_conti,i)= 0.65d0
2252 c a_chuj(2,2,num_conti,i)= 0.50d0
2253 c else if (i.eq.2) then
2254 c a_chuj(1,1,num_conti,i)= 0.0d0
2255 c a_chuj(1,2,num_conti,i)= 0.0d0
2256 c a_chuj(2,1,num_conti,i)= 0.0d0
2257 c a_chuj(2,2,num_conti,i)= 0.0d0
2259 C --- and its gradients
2260 cd write (iout,*) 'i',i,' j',j
2262 cd write (iout,*) 'iii 1 kkk',kkk
2263 cd write (iout,*) agg(kkk,:)
2266 cd write (iout,*) 'iii 2 kkk',kkk
2267 cd write (iout,*) aggi(kkk,:)
2270 cd write (iout,*) 'iii 3 kkk',kkk
2271 cd write (iout,*) aggi1(kkk,:)
2274 cd write (iout,*) 'iii 4 kkk',kkk
2275 cd write (iout,*) aggj(kkk,:)
2278 cd write (iout,*) 'iii 5 kkk',kkk
2279 cd write (iout,*) aggj1(kkk,:)
2286 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2287 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2288 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2289 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2290 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2292 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2298 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2299 C Calculate contact energies
2301 wij=cosa-3.0D0*cosb*cosg
2304 c fac3=dsqrt(-ael6i)/r0ij**3
2305 fac3=dsqrt(-ael6i)*r3ij
2306 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2307 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2309 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2310 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2311 C Diagnostics. Comment out or remove after debugging!
2312 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2313 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2314 c ees0m(num_conti,i)=0.0D0
2316 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2317 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2318 facont_hb(num_conti,i)=fcont
2320 C Angular derivatives of the contact function
2321 ees0pij1=fac3/ees0pij
2322 ees0mij1=fac3/ees0mij
2323 fac3p=-3.0D0*fac3*rrmij
2324 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2325 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2327 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2328 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2329 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2330 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2331 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2332 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2333 ecosap=ecosa1+ecosa2
2334 ecosbp=ecosb1+ecosb2
2335 ecosgp=ecosg1+ecosg2
2336 ecosam=ecosa1-ecosa2
2337 ecosbm=ecosb1-ecosb2
2338 ecosgm=ecosg1-ecosg2
2347 fprimcont=fprimcont/rij
2348 cd facont_hb(num_conti,i)=1.0D0
2349 C Following line is for diagnostics.
2352 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2353 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2356 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2357 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2359 gggp(1)=gggp(1)+ees0pijp*xj
2360 gggp(2)=gggp(2)+ees0pijp*yj
2361 gggp(3)=gggp(3)+ees0pijp*zj
2362 gggm(1)=gggm(1)+ees0mijp*xj
2363 gggm(2)=gggm(2)+ees0mijp*yj
2364 gggm(3)=gggm(3)+ees0mijp*zj
2365 C Derivatives due to the contact function
2366 gacont_hbr(1,num_conti,i)=fprimcont*xj
2367 gacont_hbr(2,num_conti,i)=fprimcont*yj
2368 gacont_hbr(3,num_conti,i)=fprimcont*zj
2370 ghalfp=0.5D0*gggp(k)
2371 ghalfm=0.5D0*gggm(k)
2372 gacontp_hb1(k,num_conti,i)=ghalfp
2373 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2374 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2375 gacontp_hb2(k,num_conti,i)=ghalfp
2376 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2377 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2378 gacontp_hb3(k,num_conti,i)=gggp(k)
2379 gacontm_hb1(k,num_conti,i)=ghalfm
2380 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2381 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2382 gacontm_hb2(k,num_conti,i)=ghalfm
2383 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2384 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2385 gacontm_hb3(k,num_conti,i)=gggm(k)
2388 C Diagnostics. Comment out or remove after debugging!
2390 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2391 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2392 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2393 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2394 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2395 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2398 endif ! num_conti.le.maxconts
2403 num_cont_hb(i)=num_conti
2407 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2408 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2410 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2411 ccc eel_loc=eel_loc+eello_turn3
2414 C-----------------------------------------------------------------------------
2415 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2416 C Third- and fourth-order contributions from turns
2417 implicit real*8 (a-h,o-z)
2418 include 'DIMENSIONS'
2419 include 'sizesclu.dat'
2420 include 'COMMON.IOUNITS'
2421 include 'COMMON.GEO'
2422 include 'COMMON.VAR'
2423 include 'COMMON.LOCAL'
2424 include 'COMMON.CHAIN'
2425 include 'COMMON.DERIV'
2426 include 'COMMON.INTERACT'
2427 include 'COMMON.CONTACTS'
2428 include 'COMMON.TORSION'
2429 include 'COMMON.VECTORS'
2430 include 'COMMON.FFIELD'
2432 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2433 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2434 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2435 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2436 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2437 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2439 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2441 C Third-order contributions
2448 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2449 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2450 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2451 call transpose2(auxmat(1,1),auxmat1(1,1))
2452 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2453 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2454 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2455 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2456 cd & ' eello_turn3_num',4*eello_turn3_num
2458 C Derivatives in gamma(i)
2459 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2460 call transpose2(auxmat2(1,1),pizda(1,1))
2461 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2462 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2463 C Derivatives in gamma(i+1)
2464 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2465 call transpose2(auxmat2(1,1),pizda(1,1))
2466 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2467 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2468 & +0.5d0*(pizda(1,1)+pizda(2,2))
2469 C Cartesian derivatives
2471 a_temp(1,1)=aggi(l,1)
2472 a_temp(1,2)=aggi(l,2)
2473 a_temp(2,1)=aggi(l,3)
2474 a_temp(2,2)=aggi(l,4)
2475 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2476 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2477 & +0.5d0*(pizda(1,1)+pizda(2,2))
2478 a_temp(1,1)=aggi1(l,1)
2479 a_temp(1,2)=aggi1(l,2)
2480 a_temp(2,1)=aggi1(l,3)
2481 a_temp(2,2)=aggi1(l,4)
2482 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2483 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2484 & +0.5d0*(pizda(1,1)+pizda(2,2))
2485 a_temp(1,1)=aggj(l,1)
2486 a_temp(1,2)=aggj(l,2)
2487 a_temp(2,1)=aggj(l,3)
2488 a_temp(2,2)=aggj(l,4)
2489 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2490 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2491 & +0.5d0*(pizda(1,1)+pizda(2,2))
2492 a_temp(1,1)=aggj1(l,1)
2493 a_temp(1,2)=aggj1(l,2)
2494 a_temp(2,1)=aggj1(l,3)
2495 a_temp(2,2)=aggj1(l,4)
2496 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2497 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2498 & +0.5d0*(pizda(1,1)+pizda(2,2))
2501 else if (j.eq.i+3) then
2502 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2504 C Fourth-order contributions
2512 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2513 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2514 iti1=itortyp(itype(i+1))
2515 iti2=itortyp(itype(i+2))
2516 iti3=itortyp(itype(i+3))
2517 call transpose2(EUg(1,1,i+1),e1t(1,1))
2518 call transpose2(Eug(1,1,i+2),e2t(1,1))
2519 call transpose2(Eug(1,1,i+3),e3t(1,1))
2520 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2521 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2522 s1=scalar2(b1(1,iti2),auxvec(1))
2523 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2524 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2525 s2=scalar2(b1(1,iti1),auxvec(1))
2526 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2527 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2528 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2529 eello_turn4=eello_turn4-(s1+s2+s3)
2530 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2531 cd & ' eello_turn4_num',8*eello_turn4_num
2532 C Derivatives in gamma(i)
2534 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2535 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2536 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2537 s1=scalar2(b1(1,iti2),auxvec(1))
2538 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2539 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2540 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2541 C Derivatives in gamma(i+1)
2542 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2543 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2544 s2=scalar2(b1(1,iti1),auxvec(1))
2545 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2546 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2547 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2548 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2549 C Derivatives in gamma(i+2)
2550 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2551 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2552 s1=scalar2(b1(1,iti2),auxvec(1))
2553 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2554 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2555 s2=scalar2(b1(1,iti1),auxvec(1))
2556 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2557 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2558 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2559 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2560 C Cartesian derivatives
2561 C Derivatives of this turn contributions in DC(i+2)
2562 if (j.lt.nres-1) then
2564 a_temp(1,1)=agg(l,1)
2565 a_temp(1,2)=agg(l,2)
2566 a_temp(2,1)=agg(l,3)
2567 a_temp(2,2)=agg(l,4)
2568 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2569 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2570 s1=scalar2(b1(1,iti2),auxvec(1))
2571 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2572 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2573 s2=scalar2(b1(1,iti1),auxvec(1))
2574 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2575 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2576 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2578 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2581 C Remaining derivatives of this turn contribution
2583 a_temp(1,1)=aggi(l,1)
2584 a_temp(1,2)=aggi(l,2)
2585 a_temp(2,1)=aggi(l,3)
2586 a_temp(2,2)=aggi(l,4)
2587 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2588 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2589 s1=scalar2(b1(1,iti2),auxvec(1))
2590 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2591 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2592 s2=scalar2(b1(1,iti1),auxvec(1))
2593 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2594 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2595 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2596 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2597 a_temp(1,1)=aggi1(l,1)
2598 a_temp(1,2)=aggi1(l,2)
2599 a_temp(2,1)=aggi1(l,3)
2600 a_temp(2,2)=aggi1(l,4)
2601 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2602 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2603 s1=scalar2(b1(1,iti2),auxvec(1))
2604 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2605 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2606 s2=scalar2(b1(1,iti1),auxvec(1))
2607 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2608 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2609 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2610 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2611 a_temp(1,1)=aggj(l,1)
2612 a_temp(1,2)=aggj(l,2)
2613 a_temp(2,1)=aggj(l,3)
2614 a_temp(2,2)=aggj(l,4)
2615 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2616 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2617 s1=scalar2(b1(1,iti2),auxvec(1))
2618 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2619 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2620 s2=scalar2(b1(1,iti1),auxvec(1))
2621 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2622 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2623 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2624 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2625 a_temp(1,1)=aggj1(l,1)
2626 a_temp(1,2)=aggj1(l,2)
2627 a_temp(2,1)=aggj1(l,3)
2628 a_temp(2,2)=aggj1(l,4)
2629 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2630 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2631 s1=scalar2(b1(1,iti2),auxvec(1))
2632 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2633 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2634 s2=scalar2(b1(1,iti1),auxvec(1))
2635 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2636 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2637 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2638 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2644 C-----------------------------------------------------------------------------
2645 subroutine vecpr(u,v,w)
2646 implicit real*8(a-h,o-z)
2647 dimension u(3),v(3),w(3)
2648 w(1)=u(2)*v(3)-u(3)*v(2)
2649 w(2)=-u(1)*v(3)+u(3)*v(1)
2650 w(3)=u(1)*v(2)-u(2)*v(1)
2653 C-----------------------------------------------------------------------------
2654 subroutine unormderiv(u,ugrad,unorm,ungrad)
2655 C This subroutine computes the derivatives of a normalized vector u, given
2656 C the derivatives computed without normalization conditions, ugrad. Returns
2659 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2660 double precision vec(3)
2661 double precision scalar
2663 c write (2,*) 'ugrad',ugrad
2666 vec(i)=scalar(ugrad(1,i),u(1))
2668 c write (2,*) 'vec',vec
2671 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2674 c write (2,*) 'ungrad',ungrad
2677 C-----------------------------------------------------------------------------
2678 subroutine escp(evdw2,evdw2_14)
2680 C This subroutine calculates the excluded-volume interaction energy between
2681 C peptide-group centers and side chains and its gradient in virtual-bond and
2682 C side-chain vectors.
2684 implicit real*8 (a-h,o-z)
2685 include 'DIMENSIONS'
2686 include 'sizesclu.dat'
2687 include 'COMMON.GEO'
2688 include 'COMMON.VAR'
2689 include 'COMMON.LOCAL'
2690 include 'COMMON.CHAIN'
2691 include 'COMMON.DERIV'
2692 include 'COMMON.INTERACT'
2693 include 'COMMON.FFIELD'
2694 include 'COMMON.IOUNITS'
2698 cd print '(a)','Enter ESCP'
2699 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2700 c & ' scal14',scal14
2701 do i=iatscp_s,iatscp_e
2703 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2704 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2705 if (iteli.eq.0) goto 1225
2706 xi=0.5D0*(c(1,i)+c(1,i+1))
2707 yi=0.5D0*(c(2,i)+c(2,i+1))
2708 zi=0.5D0*(c(3,i)+c(3,i+1))
2710 do iint=1,nscp_gr(i)
2712 do j=iscpstart(i,iint),iscpend(i,iint)
2714 C Uncomment following three lines for SC-p interactions
2718 C Uncomment following three lines for Ca-p interactions
2722 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2724 e1=fac*fac*aad(itypj,iteli)
2725 e2=fac*bad(itypj,iteli)
2726 if (iabs(j-i) .le. 2) then
2729 evdw2_14=evdw2_14+e1+e2
2732 c write (iout,*) i,j,evdwij
2736 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2738 fac=-(evdwij+e1)*rrij
2743 cd write (iout,*) 'j<i'
2744 C Uncomment following three lines for SC-p interactions
2746 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2749 cd write (iout,*) 'j>i'
2752 C Uncomment following line for SC-p interactions
2753 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2757 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2761 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2762 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2765 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2775 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2776 gradx_scp(j,i)=expon*gradx_scp(j,i)
2779 C******************************************************************************
2783 C To save time the factor EXPON has been extracted from ALL components
2784 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2787 C******************************************************************************
2790 C--------------------------------------------------------------------------
2791 subroutine edis(ehpb)
2793 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2795 implicit real*8 (a-h,o-z)
2796 include 'DIMENSIONS'
2797 include 'sizesclu.dat'
2798 include 'COMMON.SBRIDGE'
2799 include 'COMMON.CHAIN'
2800 include 'COMMON.DERIV'
2801 include 'COMMON.VAR'
2802 include 'COMMON.INTERACT'
2805 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2806 cd print *,'link_start=',link_start,' link_end=',link_end
2807 if (link_end.eq.0) return
2808 do i=link_start,link_end
2809 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2810 C CA-CA distance used in regularization of structure.
2813 C iii and jjj point to the residues for which the distance is assigned.
2814 if (ii.gt.nres) then
2821 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2822 C distance and angle dependent SS bond potential.
2823 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2824 call ssbond_ene(iii,jjj,eij)
2827 C Calculate the distance between the two points and its difference from the
2831 C Get the force constant corresponding to this distance.
2833 C Calculate the contribution to energy.
2834 ehpb=ehpb+waga*rdis*rdis
2836 C Evaluate gradient.
2839 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2840 cd & ' waga=',waga,' fac=',fac
2842 ggg(j)=fac*(c(j,jj)-c(j,ii))
2844 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2845 C If this is a SC-SC distance, we need to calculate the contributions to the
2846 C Cartesian gradient in the SC vectors (ghpbx).
2849 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2850 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2855 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2863 C--------------------------------------------------------------------------
2864 subroutine ssbond_ene(i,j,eij)
2866 C Calculate the distance and angle dependent SS-bond potential energy
2867 C using a free-energy function derived based on RHF/6-31G** ab initio
2868 C calculations of diethyl disulfide.
2870 C A. Liwo and U. Kozlowska, 11/24/03
2872 implicit real*8 (a-h,o-z)
2873 include 'DIMENSIONS'
2874 include 'sizesclu.dat'
2875 include 'COMMON.SBRIDGE'
2876 include 'COMMON.CHAIN'
2877 include 'COMMON.DERIV'
2878 include 'COMMON.LOCAL'
2879 include 'COMMON.INTERACT'
2880 include 'COMMON.VAR'
2881 include 'COMMON.IOUNITS'
2882 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2887 dxi=dc_norm(1,nres+i)
2888 dyi=dc_norm(2,nres+i)
2889 dzi=dc_norm(3,nres+i)
2890 dsci_inv=dsc_inv(itypi)
2892 dscj_inv=dsc_inv(itypj)
2896 dxj=dc_norm(1,nres+j)
2897 dyj=dc_norm(2,nres+j)
2898 dzj=dc_norm(3,nres+j)
2899 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2904 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2905 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2906 om12=dxi*dxj+dyi*dyj+dzi*dzj
2908 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2909 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2915 deltat12=om2-om1+2.0d0
2917 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2918 & +akct*deltad*deltat12
2919 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2920 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2921 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2922 c & " deltat12",deltat12," eij",eij
2923 ed=2*akcm*deltad+akct*deltat12
2925 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
2926 eom1=-2*akth*deltat1-pom1-om2*pom2
2927 eom2= 2*akth*deltat2+pom1-om1*pom2
2930 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2933 ghpbx(k,i)=ghpbx(k,i)-gg(k)
2934 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
2935 ghpbx(k,j)=ghpbx(k,j)+gg(k)
2936 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
2939 C Calculate the components of the gradient in DC and X
2943 ghpbc(l,k)=ghpbc(l,k)+gg(l)
2948 C--------------------------------------------------------------------------
2949 subroutine ebond(estr)
2951 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
2953 implicit real*8 (a-h,o-z)
2954 include 'DIMENSIONS'
2955 include 'COMMON.LOCAL'
2956 include 'COMMON.GEO'
2957 include 'COMMON.INTERACT'
2958 include 'COMMON.DERIV'
2959 include 'COMMON.VAR'
2960 include 'COMMON.CHAIN'
2961 include 'COMMON.IOUNITS'
2962 include 'COMMON.NAMES'
2963 include 'COMMON.FFIELD'
2964 include 'COMMON.CONTROL'
2965 double precision u(3),ud(3)
2968 diff = vbld(i)-vbldp0
2969 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
2972 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
2977 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
2984 diff=vbld(i+nres)-vbldsc0(1,iti)
2985 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
2986 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
2987 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
2989 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
2993 diff=vbld(i+nres)-vbldsc0(j,iti)
2994 ud(j)=aksc(j,iti)*diff
2995 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3009 uprod2=uprod2*u(k)*u(k)
3013 usumsqder=usumsqder+ud(j)*uprod2
3015 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3016 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3017 estr=estr+uprod/usum
3019 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3027 C--------------------------------------------------------------------------
3028 subroutine ebend(etheta)
3030 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3031 C angles gamma and its derivatives in consecutive thetas and gammas.
3033 implicit real*8 (a-h,o-z)
3034 include 'DIMENSIONS'
3035 include 'sizesclu.dat'
3036 include 'COMMON.LOCAL'
3037 include 'COMMON.GEO'
3038 include 'COMMON.INTERACT'
3039 include 'COMMON.DERIV'
3040 include 'COMMON.VAR'
3041 include 'COMMON.CHAIN'
3042 include 'COMMON.IOUNITS'
3043 include 'COMMON.NAMES'
3044 include 'COMMON.FFIELD'
3045 common /calcthet/ term1,term2,termm,diffak,ratak,
3046 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3047 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3048 double precision y(2),z(2)
3050 time11=dexp(-2*time)
3053 c write (iout,*) "nres",nres
3054 c write (*,'(a,i2)') 'EBEND ICG=',icg
3055 c write (iout,*) ithet_start,ithet_end
3056 do i=ithet_start,ithet_end
3057 C Zero the energy function and its derivative at 0 or pi.
3058 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3060 c if (i.gt.ithet_start .and.
3061 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3062 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3070 c if (i.lt.nres .and. itel(i).ne.0) then
3082 call proc_proc(phii,icrc)
3083 if (icrc.eq.1) phii=150.0
3097 call proc_proc(phii1,icrc)
3098 if (icrc.eq.1) phii1=150.0
3110 C Calculate the "mean" value of theta from the part of the distribution
3111 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3112 C In following comments this theta will be referred to as t_c.
3113 thet_pred_mean=0.0d0
3117 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3119 c write (iout,*) "thet_pred_mean",thet_pred_mean
3120 dthett=thet_pred_mean*ssd
3121 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3122 c write (iout,*) "thet_pred_mean",thet_pred_mean
3123 C Derivatives of the "mean" values in gamma1 and gamma2.
3124 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3125 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3126 if (theta(i).gt.pi-delta) then
3127 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3129 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3130 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3131 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3133 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3135 else if (theta(i).lt.delta) then
3136 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3137 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3138 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3140 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3141 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3144 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3147 etheta=etheta+ethetai
3148 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3149 c & rad2deg*phii,rad2deg*phii1,ethetai
3150 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3151 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3152 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3155 C Ufff.... We've done all this!!!
3158 C---------------------------------------------------------------------------
3159 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3161 implicit real*8 (a-h,o-z)
3162 include 'DIMENSIONS'
3163 include 'COMMON.LOCAL'
3164 include 'COMMON.IOUNITS'
3165 common /calcthet/ term1,term2,termm,diffak,ratak,
3166 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3167 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3168 C Calculate the contributions to both Gaussian lobes.
3169 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3170 C The "polynomial part" of the "standard deviation" of this part of
3174 sig=sig*thet_pred_mean+polthet(j,it)
3176 C Derivative of the "interior part" of the "standard deviation of the"
3177 C gamma-dependent Gaussian lobe in t_c.
3178 sigtc=3*polthet(3,it)
3180 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3183 C Set the parameters of both Gaussian lobes of the distribution.
3184 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3185 fac=sig*sig+sigc0(it)
3188 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3189 sigsqtc=-4.0D0*sigcsq*sigtc
3190 c print *,i,sig,sigtc,sigsqtc
3191 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3192 sigtc=-sigtc/(fac*fac)
3193 C Following variable is sigma(t_c)**(-2)
3194 sigcsq=sigcsq*sigcsq
3196 sig0inv=1.0D0/sig0i**2
3197 delthec=thetai-thet_pred_mean
3198 delthe0=thetai-theta0i
3199 term1=-0.5D0*sigcsq*delthec*delthec
3200 term2=-0.5D0*sig0inv*delthe0*delthe0
3201 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3202 C NaNs in taking the logarithm. We extract the largest exponent which is added
3203 C to the energy (this being the log of the distribution) at the end of energy
3204 C term evaluation for this virtual-bond angle.
3205 if (term1.gt.term2) then
3207 term2=dexp(term2-termm)
3211 term1=dexp(term1-termm)
3214 C The ratio between the gamma-independent and gamma-dependent lobes of
3215 C the distribution is a Gaussian function of thet_pred_mean too.
3216 diffak=gthet(2,it)-thet_pred_mean
3217 ratak=diffak/gthet(3,it)**2
3218 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3219 C Let's differentiate it in thet_pred_mean NOW.
3221 C Now put together the distribution terms to make complete distribution.
3222 termexp=term1+ak*term2
3223 termpre=sigc+ak*sig0i
3224 C Contribution of the bending energy from this theta is just the -log of
3225 C the sum of the contributions from the two lobes and the pre-exponential
3226 C factor. Simple enough, isn't it?
3227 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3228 C NOW the derivatives!!!
3229 C 6/6/97 Take into account the deformation.
3230 E_theta=(delthec*sigcsq*term1
3231 & +ak*delthe0*sig0inv*term2)/termexp
3232 E_tc=((sigtc+aktc*sig0i)/termpre
3233 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3234 & aktc*term2)/termexp)
3237 c-----------------------------------------------------------------------------
3238 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3239 implicit real*8 (a-h,o-z)
3240 include 'DIMENSIONS'
3241 include 'COMMON.LOCAL'
3242 include 'COMMON.IOUNITS'
3243 common /calcthet/ term1,term2,termm,diffak,ratak,
3244 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3245 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3246 delthec=thetai-thet_pred_mean
3247 delthe0=thetai-theta0i
3248 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3249 t3 = thetai-thet_pred_mean
3253 t14 = t12+t6*sigsqtc
3255 t21 = thetai-theta0i
3261 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3262 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3263 & *(-t12*t9-ak*sig0inv*t27)
3267 C--------------------------------------------------------------------------
3268 subroutine ebend(etheta)
3270 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3271 C angles gamma and its derivatives in consecutive thetas and gammas.
3272 C ab initio-derived potentials from
3273 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3275 implicit real*8 (a-h,o-z)
3276 include 'DIMENSIONS'
3277 include 'COMMON.LOCAL'
3278 include 'COMMON.GEO'
3279 include 'COMMON.INTERACT'
3280 include 'COMMON.DERIV'
3281 include 'COMMON.VAR'
3282 include 'COMMON.CHAIN'
3283 include 'COMMON.IOUNITS'
3284 include 'COMMON.NAMES'
3285 include 'COMMON.FFIELD'
3286 include 'COMMON.CONTROL'
3287 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3288 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3289 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3290 & sinph1ph2(maxdouble,maxdouble)
3291 logical lprn /.false./, lprn1 /.false./
3293 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3294 do i=ithet_start,ithet_end
3298 theti2=0.5d0*theta(i)
3299 ityp2=ithetyp(itype(i-1))
3301 coskt(k)=dcos(k*theti2)
3302 sinkt(k)=dsin(k*theti2)
3307 if (phii.ne.phii) phii=150.0
3311 ityp1=ithetyp(itype(i-2))
3313 cosph1(k)=dcos(k*phii)
3314 sinph1(k)=dsin(k*phii)
3327 if (phii1.ne.phii1) phii1=150.0
3332 ityp3=ithetyp(itype(i))
3334 cosph2(k)=dcos(k*phii1)
3335 sinph2(k)=dsin(k*phii1)
3345 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3346 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3348 ethetai=aa0thet(ityp1,ityp2,ityp3)
3351 ccl=cosph1(l)*cosph2(k-l)
3352 ssl=sinph1(l)*sinph2(k-l)
3353 scl=sinph1(l)*cosph2(k-l)
3354 csl=cosph1(l)*sinph2(k-l)
3355 cosph1ph2(l,k)=ccl-ssl
3356 cosph1ph2(k,l)=ccl+ssl
3357 sinph1ph2(l,k)=scl+csl
3358 sinph1ph2(k,l)=scl-csl
3362 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3363 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3364 write (iout,*) "coskt and sinkt"
3366 write (iout,*) k,coskt(k),sinkt(k)
3370 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3371 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3374 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3375 & " ethetai",ethetai
3378 write (iout,*) "cosph and sinph"
3380 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3382 write (iout,*) "cosph1ph2 and sinph2ph2"
3385 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3386 & sinph1ph2(l,k),sinph1ph2(k,l)
3389 write(iout,*) "ethetai",ethetai
3393 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3394 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3395 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3396 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3397 ethetai=ethetai+sinkt(m)*aux
3398 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3399 dephii=dephii+k*sinkt(m)*(
3400 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3401 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3402 dephii1=dephii1+k*sinkt(m)*(
3403 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3404 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3406 & write (iout,*) "m",m," k",k," bbthet",
3407 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3408 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3409 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3410 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3414 & write(iout,*) "ethetai",ethetai
3418 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3419 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3420 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3421 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3422 ethetai=ethetai+sinkt(m)*aux
3423 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3424 dephii=dephii+l*sinkt(m)*(
3425 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3426 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3427 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3428 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3429 dephii1=dephii1+(k-l)*sinkt(m)*(
3430 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3431 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3432 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3433 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3435 write (iout,*) "m",m," k",k," l",l," ffthet",
3436 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3437 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3438 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3439 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3440 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3441 & cosph1ph2(k,l)*sinkt(m),
3442 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3448 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3449 & i,theta(i)*rad2deg,phii*rad2deg,
3450 & phii1*rad2deg,ethetai
3451 etheta=etheta+ethetai
3452 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3453 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3454 gloc(nphi+i-2,icg)=wang*dethetai
3460 c-----------------------------------------------------------------------------
3461 subroutine esc(escloc)
3462 C Calculate the local energy of a side chain and its derivatives in the
3463 C corresponding virtual-bond valence angles THETA and the spherical angles
3465 implicit real*8 (a-h,o-z)
3466 include 'DIMENSIONS'
3467 include 'sizesclu.dat'
3468 include 'COMMON.GEO'
3469 include 'COMMON.LOCAL'
3470 include 'COMMON.VAR'
3471 include 'COMMON.INTERACT'
3472 include 'COMMON.DERIV'
3473 include 'COMMON.CHAIN'
3474 include 'COMMON.IOUNITS'
3475 include 'COMMON.NAMES'
3476 include 'COMMON.FFIELD'
3477 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3478 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3479 common /sccalc/ time11,time12,time112,theti,it,nlobit
3482 c write (iout,'(a)') 'ESC'
3483 do i=loc_start,loc_end
3485 if (it.eq.10) goto 1
3487 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3488 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3489 theti=theta(i+1)-pipol
3493 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3495 if (x(2).gt.pi-delta) then
3499 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3501 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3502 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3504 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3505 & ddersc0(1),dersc(1))
3506 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3507 & ddersc0(3),dersc(3))
3509 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3511 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3512 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3513 & dersc0(2),esclocbi,dersc02)
3514 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3516 call splinthet(x(2),0.5d0*delta,ss,ssd)
3521 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3523 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3524 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3526 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3528 c write (iout,*) escloci
3529 else if (x(2).lt.delta) then
3533 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3535 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3536 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3538 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3539 & ddersc0(1),dersc(1))
3540 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3541 & ddersc0(3),dersc(3))
3543 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3545 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3546 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3547 & dersc0(2),esclocbi,dersc02)
3548 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3553 call splinthet(x(2),0.5d0*delta,ss,ssd)
3555 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3557 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3558 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3560 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3561 c write (iout,*) escloci
3563 call enesc(x,escloci,dersc,ddummy,.false.)
3566 escloc=escloc+escloci
3567 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3569 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3571 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3572 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3577 C---------------------------------------------------------------------------
3578 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3579 implicit real*8 (a-h,o-z)
3580 include 'DIMENSIONS'
3581 include 'COMMON.GEO'
3582 include 'COMMON.LOCAL'
3583 include 'COMMON.IOUNITS'
3584 common /sccalc/ time11,time12,time112,theti,it,nlobit
3585 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3586 double precision contr(maxlob,-1:1)
3588 c write (iout,*) 'it=',it,' nlobit=',nlobit
3592 if (mixed) ddersc(j)=0.0d0
3596 C Because of periodicity of the dependence of the SC energy in omega we have
3597 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3598 C To avoid underflows, first compute & store the exponents.
3606 z(k)=x(k)-censc(k,j,it)
3611 Axk=Axk+gaussc(l,k,j,it)*z(l)
3617 expfac=expfac+Ax(k,j,iii)*z(k)
3625 C As in the case of ebend, we want to avoid underflows in exponentiation and
3626 C subsequent NaNs and INFs in energy calculation.
3627 C Find the largest exponent
3631 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3635 cd print *,'it=',it,' emin=',emin
3637 C Compute the contribution to SC energy and derivatives
3641 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3642 cd print *,'j=',j,' expfac=',expfac
3643 escloc_i=escloc_i+expfac
3645 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3649 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3650 & +gaussc(k,2,j,it))*expfac
3657 dersc(1)=dersc(1)/cos(theti)**2
3658 ddersc(1)=ddersc(1)/cos(theti)**2
3661 escloci=-(dlog(escloc_i)-emin)
3663 dersc(j)=dersc(j)/escloc_i
3667 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3672 C------------------------------------------------------------------------------
3673 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3674 implicit real*8 (a-h,o-z)
3675 include 'DIMENSIONS'
3676 include 'COMMON.GEO'
3677 include 'COMMON.LOCAL'
3678 include 'COMMON.IOUNITS'
3679 common /sccalc/ time11,time12,time112,theti,it,nlobit
3680 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3681 double precision contr(maxlob)
3692 z(k)=x(k)-censc(k,j,it)
3698 Axk=Axk+gaussc(l,k,j,it)*z(l)
3704 expfac=expfac+Ax(k,j)*z(k)
3709 C As in the case of ebend, we want to avoid underflows in exponentiation and
3710 C subsequent NaNs and INFs in energy calculation.
3711 C Find the largest exponent
3714 if (emin.gt.contr(j)) emin=contr(j)
3718 C Compute the contribution to SC energy and derivatives
3722 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3723 escloc_i=escloc_i+expfac
3725 dersc(k)=dersc(k)+Ax(k,j)*expfac
3727 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3728 & +gaussc(1,2,j,it))*expfac
3732 dersc(1)=dersc(1)/cos(theti)**2
3733 dersc12=dersc12/cos(theti)**2
3734 escloci=-(dlog(escloc_i)-emin)
3736 dersc(j)=dersc(j)/escloc_i
3738 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3742 c----------------------------------------------------------------------------------
3743 subroutine esc(escloc)
3744 C Calculate the local energy of a side chain and its derivatives in the
3745 C corresponding virtual-bond valence angles THETA and the spherical angles
3746 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3747 C added by Urszula Kozlowska. 07/11/2007
3749 implicit real*8 (a-h,o-z)
3750 include 'DIMENSIONS'
3751 include 'COMMON.GEO'
3752 include 'COMMON.LOCAL'
3753 include 'COMMON.VAR'
3754 include 'COMMON.SCROT'
3755 include 'COMMON.INTERACT'
3756 include 'COMMON.DERIV'
3757 include 'COMMON.CHAIN'
3758 include 'COMMON.IOUNITS'
3759 include 'COMMON.NAMES'
3760 include 'COMMON.FFIELD'
3761 include 'COMMON.CONTROL'
3762 include 'COMMON.VECTORS'
3763 double precision x_prime(3),y_prime(3),z_prime(3)
3764 & , sumene,dsc_i,dp2_i,x(65),
3765 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3766 & de_dxx,de_dyy,de_dzz,de_dt
3767 double precision s1_t,s1_6_t,s2_t,s2_6_t
3769 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3770 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3771 & dt_dCi(3),dt_dCi1(3)
3772 common /sccalc/ time11,time12,time112,theti,it,nlobit
3775 do i=loc_start,loc_end
3776 costtab(i+1) =dcos(theta(i+1))
3777 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3778 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3779 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3780 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3781 cosfac=dsqrt(cosfac2)
3782 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3783 sinfac=dsqrt(sinfac2)
3785 if (it.eq.10) goto 1
3787 C Compute the axes of tghe local cartesian coordinates system; store in
3788 c x_prime, y_prime and z_prime
3795 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3796 C & dc_norm(3,i+nres)
3798 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3799 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3802 z_prime(j) = -uz(j,i-1)
3805 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3806 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3807 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3808 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3809 c & " xy",scalar(x_prime(1),y_prime(1)),
3810 c & " xz",scalar(x_prime(1),z_prime(1)),
3811 c & " yy",scalar(y_prime(1),y_prime(1)),
3812 c & " yz",scalar(y_prime(1),z_prime(1)),
3813 c & " zz",scalar(z_prime(1),z_prime(1))
3815 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3816 C to local coordinate system. Store in xx, yy, zz.
3822 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3823 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3824 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3831 C Compute the energy of the ith side cbain
3833 c write (2,*) "xx",xx," yy",yy," zz",zz
3836 x(j) = sc_parmin(j,it)
3839 Cc diagnostics - remove later
3841 yy1 = dsin(alph(2))*dcos(omeg(2))
3842 zz1 = -dsin(alph(2))*dsin(omeg(2))
3843 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3844 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3846 C," --- ", xx_w,yy_w,zz_w
3849 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3850 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3852 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3853 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3855 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3856 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3857 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3858 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3859 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3861 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3862 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3863 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3864 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3865 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3867 dsc_i = 0.743d0+x(61)
3869 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3870 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3871 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3872 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3873 s1=(1+x(63))/(0.1d0 + dscp1)
3874 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3875 s2=(1+x(65))/(0.1d0 + dscp2)
3876 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3877 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3878 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3879 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3881 c & dscp1,dscp2,sumene
3882 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3883 escloc = escloc + sumene
3884 c write (2,*) "escloc",escloc
3885 if (.not. calc_grad) goto 1
3888 C This section to check the numerical derivatives of the energy of ith side
3889 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3890 C #define DEBUG in the code to turn it on.
3892 write (2,*) "sumene =",sumene
3896 write (2,*) xx,yy,zz
3897 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3898 de_dxx_num=(sumenep-sumene)/aincr
3900 write (2,*) "xx+ sumene from enesc=",sumenep
3903 write (2,*) xx,yy,zz
3904 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3905 de_dyy_num=(sumenep-sumene)/aincr
3907 write (2,*) "yy+ sumene from enesc=",sumenep
3910 write (2,*) xx,yy,zz
3911 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3912 de_dzz_num=(sumenep-sumene)/aincr
3914 write (2,*) "zz+ sumene from enesc=",sumenep
3915 costsave=cost2tab(i+1)
3916 sintsave=sint2tab(i+1)
3917 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
3918 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
3919 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3920 de_dt_num=(sumenep-sumene)/aincr
3921 write (2,*) " t+ sumene from enesc=",sumenep
3922 cost2tab(i+1)=costsave
3923 sint2tab(i+1)=sintsave
3924 C End of diagnostics section.
3927 C Compute the gradient of esc
3929 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
3930 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
3931 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
3932 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
3933 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
3934 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
3935 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
3936 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
3937 pom1=(sumene3*sint2tab(i+1)+sumene1)
3938 & *(pom_s1/dscp1+pom_s16*dscp1**4)
3939 pom2=(sumene4*cost2tab(i+1)+sumene2)
3940 & *(pom_s2/dscp2+pom_s26*dscp2**4)
3941 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
3942 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
3943 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
3945 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
3946 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
3947 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
3949 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
3950 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
3951 & +(pom1+pom2)*pom_dx
3953 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
3956 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
3957 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
3958 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
3960 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
3961 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
3962 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
3963 & +x(59)*zz**2 +x(60)*xx*zz
3964 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
3965 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
3966 & +(pom1-pom2)*pom_dy
3968 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
3971 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
3972 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
3973 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
3974 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
3975 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
3976 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
3977 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
3978 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
3980 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
3983 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
3984 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
3985 & +pom1*pom_dt1+pom2*pom_dt2
3987 write(2,*), "de_dt = ", de_dt,de_dt_num
3991 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
3992 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
3993 cosfac2xx=cosfac2*xx
3994 sinfac2yy=sinfac2*yy
3996 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
3998 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4000 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4001 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4002 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4003 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4004 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4005 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4006 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4007 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4008 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4009 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4013 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4014 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4017 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4018 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4019 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4021 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4022 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4026 dXX_Ctab(k,i)=dXX_Ci(k)
4027 dXX_C1tab(k,i)=dXX_Ci1(k)
4028 dYY_Ctab(k,i)=dYY_Ci(k)
4029 dYY_C1tab(k,i)=dYY_Ci1(k)
4030 dZZ_Ctab(k,i)=dZZ_Ci(k)
4031 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4032 dXX_XYZtab(k,i)=dXX_XYZ(k)
4033 dYY_XYZtab(k,i)=dYY_XYZ(k)
4034 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4038 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4039 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4040 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4041 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4042 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4044 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4045 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4046 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4047 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4048 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4049 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4050 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4051 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4053 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4054 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4056 C to check gradient call subroutine check_grad
4063 c------------------------------------------------------------------------------
4064 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4066 C This procedure calculates two-body contact function g(rij) and its derivative:
4069 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4072 C where x=(rij-r0ij)/delta
4074 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4077 double precision rij,r0ij,eps0ij,fcont,fprimcont
4078 double precision x,x2,x4,delta
4082 if (x.lt.-1.0D0) then
4085 else if (x.le.1.0D0) then
4088 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4089 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4096 c------------------------------------------------------------------------------
4097 subroutine splinthet(theti,delta,ss,ssder)
4098 implicit real*8 (a-h,o-z)
4099 include 'DIMENSIONS'
4100 include 'sizesclu.dat'
4101 include 'COMMON.VAR'
4102 include 'COMMON.GEO'
4105 if (theti.gt.pipol) then
4106 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4108 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4113 c------------------------------------------------------------------------------
4114 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4116 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4117 double precision ksi,ksi2,ksi3,a1,a2,a3
4118 a1=fprim0*delta/(f1-f0)
4124 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4125 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4128 c------------------------------------------------------------------------------
4129 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4131 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4132 double precision ksi,ksi2,ksi3,a1,a2,a3
4137 a2=3*(f1x-f0x)-2*fprim0x*delta
4138 a3=fprim0x*delta-2*(f1x-f0x)
4139 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4142 C-----------------------------------------------------------------------------
4144 C-----------------------------------------------------------------------------
4145 subroutine etor(etors,edihcnstr,fact)
4146 implicit real*8 (a-h,o-z)
4147 include 'DIMENSIONS'
4148 include 'sizesclu.dat'
4149 include 'COMMON.VAR'
4150 include 'COMMON.GEO'
4151 include 'COMMON.LOCAL'
4152 include 'COMMON.TORSION'
4153 include 'COMMON.INTERACT'
4154 include 'COMMON.DERIV'
4155 include 'COMMON.CHAIN'
4156 include 'COMMON.NAMES'
4157 include 'COMMON.IOUNITS'
4158 include 'COMMON.FFIELD'
4159 include 'COMMON.TORCNSTR'
4161 C Set lprn=.true. for debugging
4165 do i=iphi_start,iphi_end
4166 itori=itortyp(itype(i-2))
4167 itori1=itortyp(itype(i-1))
4170 C Proline-Proline pair is a special case...
4171 if (itori.eq.3 .and. itori1.eq.3) then
4172 if (phii.gt.-dwapi3) then
4174 fac=1.0D0/(1.0D0-cosphi)
4175 etorsi=v1(1,3,3)*fac
4176 etorsi=etorsi+etorsi
4177 etors=etors+etorsi-v1(1,3,3)
4178 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4181 v1ij=v1(j+1,itori,itori1)
4182 v2ij=v2(j+1,itori,itori1)
4185 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4186 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4190 v1ij=v1(j,itori,itori1)
4191 v2ij=v2(j,itori,itori1)
4194 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4195 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4199 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4200 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4201 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4202 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4203 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4205 ! 6/20/98 - dihedral angle constraints
4208 itori=idih_constr(i)
4211 if (difi.gt.drange(i)) then
4213 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4214 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4215 else if (difi.lt.-drange(i)) then
4217 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4218 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4220 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4221 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4223 ! write (iout,*) 'edihcnstr',edihcnstr
4226 c------------------------------------------------------------------------------
4228 subroutine etor(etors,edihcnstr,fact)
4229 implicit real*8 (a-h,o-z)
4230 include 'DIMENSIONS'
4231 include 'sizesclu.dat'
4232 include 'COMMON.VAR'
4233 include 'COMMON.GEO'
4234 include 'COMMON.LOCAL'
4235 include 'COMMON.TORSION'
4236 include 'COMMON.INTERACT'
4237 include 'COMMON.DERIV'
4238 include 'COMMON.CHAIN'
4239 include 'COMMON.NAMES'
4240 include 'COMMON.IOUNITS'
4241 include 'COMMON.FFIELD'
4242 include 'COMMON.TORCNSTR'
4244 C Set lprn=.true. for debugging
4248 do i=iphi_start,iphi_end
4249 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4250 itori=itortyp(itype(i-2))
4251 itori1=itortyp(itype(i-1))
4254 C Regular cosine and sine terms
4255 do j=1,nterm(itori,itori1)
4256 v1ij=v1(j,itori,itori1)
4257 v2ij=v2(j,itori,itori1)
4260 etors=etors+v1ij*cosphi+v2ij*sinphi
4261 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4265 C E = SUM ----------------------------------- - v1
4266 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4268 cosphi=dcos(0.5d0*phii)
4269 sinphi=dsin(0.5d0*phii)
4270 do j=1,nlor(itori,itori1)
4271 vl1ij=vlor1(j,itori,itori1)
4272 vl2ij=vlor2(j,itori,itori1)
4273 vl3ij=vlor3(j,itori,itori1)
4274 pom=vl2ij*cosphi+vl3ij*sinphi
4275 pom1=1.0d0/(pom*pom+1.0d0)
4276 etors=etors+vl1ij*pom1
4278 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4280 C Subtract the constant term
4281 etors=etors-v0(itori,itori1)
4283 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4284 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4285 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4286 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4287 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4290 ! 6/20/98 - dihedral angle constraints
4294 itori=idih_constr(i)
4297 if (difi.gt.drange(i)) then
4299 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4300 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4301 else if (difi.lt.-drange(i)) then
4303 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4304 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4306 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4307 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4309 ! write (iout,*) 'edihcnstr',edihcnstr
4312 c----------------------------------------------------------------------------
4313 subroutine etor_d(etors_d,fact2)
4314 C 6/23/01 Compute double torsional energy
4315 implicit real*8 (a-h,o-z)
4316 include 'DIMENSIONS'
4317 include 'sizesclu.dat'
4318 include 'COMMON.VAR'
4319 include 'COMMON.GEO'
4320 include 'COMMON.LOCAL'
4321 include 'COMMON.TORSION'
4322 include 'COMMON.INTERACT'
4323 include 'COMMON.DERIV'
4324 include 'COMMON.CHAIN'
4325 include 'COMMON.NAMES'
4326 include 'COMMON.IOUNITS'
4327 include 'COMMON.FFIELD'
4328 include 'COMMON.TORCNSTR'
4330 C Set lprn=.true. for debugging
4334 do i=iphi_start,iphi_end-1
4335 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4337 itori=itortyp(itype(i-2))
4338 itori1=itortyp(itype(i-1))
4339 itori2=itortyp(itype(i))
4344 C Regular cosine and sine terms
4345 do j=1,ntermd_1(itori,itori1,itori2)
4346 v1cij=v1c(1,j,itori,itori1,itori2)
4347 v1sij=v1s(1,j,itori,itori1,itori2)
4348 v2cij=v1c(2,j,itori,itori1,itori2)
4349 v2sij=v1s(2,j,itori,itori1,itori2)
4350 cosphi1=dcos(j*phii)
4351 sinphi1=dsin(j*phii)
4352 cosphi2=dcos(j*phii1)
4353 sinphi2=dsin(j*phii1)
4354 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4355 & v2cij*cosphi2+v2sij*sinphi2
4356 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4357 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4359 do k=2,ntermd_2(itori,itori1,itori2)
4361 v1cdij = v2c(k,l,itori,itori1,itori2)
4362 v2cdij = v2c(l,k,itori,itori1,itori2)
4363 v1sdij = v2s(k,l,itori,itori1,itori2)
4364 v2sdij = v2s(l,k,itori,itori1,itori2)
4365 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4366 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4367 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4368 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4369 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4370 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4371 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4372 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4373 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4374 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4377 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4378 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4384 c------------------------------------------------------------------------------
4385 subroutine eback_sc_corr(esccor,fact)
4386 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4387 c conformational states; temporarily implemented as differences
4388 c between UNRES torsional potentials (dependent on three types of
4389 c residues) and the torsional potentials dependent on all 20 types
4390 c of residues computed from AM1 energy surfaces of terminally-blocked
4391 c amino-acid residues.
4392 implicit real*8 (a-h,o-z)
4393 include 'DIMENSIONS'
4394 include 'COMMON.VAR'
4395 include 'COMMON.GEO'
4396 include 'COMMON.LOCAL'
4397 include 'COMMON.TORSION'
4398 include 'COMMON.SCCOR'
4399 include 'COMMON.INTERACT'
4400 include 'COMMON.DERIV'
4401 include 'COMMON.CHAIN'
4402 include 'COMMON.NAMES'
4403 include 'COMMON.IOUNITS'
4404 include 'COMMON.FFIELD'
4405 include 'COMMON.CONTROL'
4407 C Set lprn=.true. for debugging
4410 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4412 do i=iphi_start,iphi_end
4419 v1ij=v1sccor(j,itori,itori1)
4420 v2ij=v2sccor(j,itori,itori1)
4423 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4424 gloci=gloci+fact*j*(v2ij*cosphi-v1ij*sinphi)
4427 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4428 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4429 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
4430 gsccor_loc(i-3)=gloci
4434 c------------------------------------------------------------------------------
4435 subroutine multibody(ecorr)
4436 C This subroutine calculates multi-body contributions to energy following
4437 C the idea of Skolnick et al. If side chains I and J make a contact and
4438 C at the same time side chains I+1 and J+1 make a contact, an extra
4439 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4440 implicit real*8 (a-h,o-z)
4441 include 'DIMENSIONS'
4442 include 'COMMON.IOUNITS'
4443 include 'COMMON.DERIV'
4444 include 'COMMON.INTERACT'
4445 include 'COMMON.CONTACTS'
4446 double precision gx(3),gx1(3)
4449 C Set lprn=.true. for debugging
4453 write (iout,'(a)') 'Contact function values:'
4455 write (iout,'(i2,20(1x,i2,f10.5))')
4456 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4471 num_conti=num_cont(i)
4472 num_conti1=num_cont(i1)
4477 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4478 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4479 cd & ' ishift=',ishift
4480 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4481 C The system gains extra energy.
4482 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4483 endif ! j1==j+-ishift
4492 c------------------------------------------------------------------------------
4493 double precision function esccorr(i,j,k,l,jj,kk)
4494 implicit real*8 (a-h,o-z)
4495 include 'DIMENSIONS'
4496 include 'COMMON.IOUNITS'
4497 include 'COMMON.DERIV'
4498 include 'COMMON.INTERACT'
4499 include 'COMMON.CONTACTS'
4500 double precision gx(3),gx1(3)
4505 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4506 C Calculate the multi-body contribution to energy.
4507 C Calculate multi-body contributions to the gradient.
4508 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4509 cd & k,l,(gacont(m,kk,k),m=1,3)
4511 gx(m) =ekl*gacont(m,jj,i)
4512 gx1(m)=eij*gacont(m,kk,k)
4513 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4514 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4515 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4516 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4520 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4525 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4531 c------------------------------------------------------------------------------
4533 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4534 implicit real*8 (a-h,o-z)
4535 include 'DIMENSIONS'
4536 integer dimen1,dimen2,atom,indx
4537 double precision buffer(dimen1,dimen2)
4538 double precision zapas
4539 common /contacts_hb/ zapas(3,20,maxres,7),
4540 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4541 & num_cont_hb(maxres),jcont_hb(20,maxres)
4542 num_kont=num_cont_hb(atom)
4546 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4549 buffer(i,indx+22)=facont_hb(i,atom)
4550 buffer(i,indx+23)=ees0p(i,atom)
4551 buffer(i,indx+24)=ees0m(i,atom)
4552 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4554 buffer(1,indx+26)=dfloat(num_kont)
4557 c------------------------------------------------------------------------------
4558 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4559 implicit real*8 (a-h,o-z)
4560 include 'DIMENSIONS'
4561 integer dimen1,dimen2,atom,indx
4562 double precision buffer(dimen1,dimen2)
4563 double precision zapas
4564 common /contacts_hb/ zapas(3,20,maxres,7),
4565 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4566 & num_cont_hb(maxres),jcont_hb(20,maxres)
4567 num_kont=buffer(1,indx+26)
4568 num_kont_old=num_cont_hb(atom)
4569 num_cont_hb(atom)=num_kont+num_kont_old
4574 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4577 facont_hb(ii,atom)=buffer(i,indx+22)
4578 ees0p(ii,atom)=buffer(i,indx+23)
4579 ees0m(ii,atom)=buffer(i,indx+24)
4580 jcont_hb(ii,atom)=buffer(i,indx+25)
4584 c------------------------------------------------------------------------------
4586 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4587 C This subroutine calculates multi-body contributions to hydrogen-bonding
4588 implicit real*8 (a-h,o-z)
4589 include 'DIMENSIONS'
4590 include 'sizesclu.dat'
4591 include 'COMMON.IOUNITS'
4593 include 'COMMON.INFO'
4595 include 'COMMON.FFIELD'
4596 include 'COMMON.DERIV'
4597 include 'COMMON.INTERACT'
4598 include 'COMMON.CONTACTS'
4600 parameter (max_cont=maxconts)
4601 parameter (max_dim=2*(8*3+2))
4602 parameter (msglen1=max_cont*max_dim*4)
4603 parameter (msglen2=2*msglen1)
4604 integer source,CorrelType,CorrelID,Error
4605 double precision buffer(max_cont,max_dim)
4607 double precision gx(3),gx1(3)
4610 C Set lprn=.true. for debugging
4615 if (fgProcs.le.1) goto 30
4617 write (iout,'(a)') 'Contact function values:'
4619 write (iout,'(2i3,50(1x,i2,f5.2))')
4620 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4621 & j=1,num_cont_hb(i))
4624 C Caution! Following code assumes that electrostatic interactions concerning
4625 C a given atom are split among at most two processors!
4635 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4638 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4639 if (MyRank.gt.0) then
4640 C Send correlation contributions to the preceding processor
4642 nn=num_cont_hb(iatel_s)
4643 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4644 cd write (iout,*) 'The BUFFER array:'
4646 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4648 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4650 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4651 C Clear the contacts of the atom passed to the neighboring processor
4652 nn=num_cont_hb(iatel_s+1)
4654 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4656 num_cont_hb(iatel_s)=0
4658 cd write (iout,*) 'Processor ',MyID,MyRank,
4659 cd & ' is sending correlation contribution to processor',MyID-1,
4660 cd & ' msglen=',msglen
4661 cd write (*,*) 'Processor ',MyID,MyRank,
4662 cd & ' is sending correlation contribution to processor',MyID-1,
4663 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4664 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4665 cd write (iout,*) 'Processor ',MyID,
4666 cd & ' has sent correlation contribution to processor',MyID-1,
4667 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4668 cd write (*,*) 'Processor ',MyID,
4669 cd & ' has sent correlation contribution to processor',MyID-1,
4670 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4672 endif ! (MyRank.gt.0)
4676 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4677 if (MyRank.lt.fgProcs-1) then
4678 C Receive correlation contributions from the next processor
4680 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4681 cd write (iout,*) 'Processor',MyID,
4682 cd & ' is receiving correlation contribution from processor',MyID+1,
4683 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4684 cd write (*,*) 'Processor',MyID,
4685 cd & ' is receiving correlation contribution from processor',MyID+1,
4686 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4688 do while (nbytes.le.0)
4689 call mp_probe(MyID+1,CorrelType,nbytes)
4691 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4692 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4693 cd write (iout,*) 'Processor',MyID,
4694 cd & ' has received correlation contribution from processor',MyID+1,
4695 cd & ' msglen=',msglen,' nbytes=',nbytes
4696 cd write (iout,*) 'The received BUFFER array:'
4698 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4700 if (msglen.eq.msglen1) then
4701 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4702 else if (msglen.eq.msglen2) then
4703 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4704 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4707 & 'ERROR!!!! message length changed while processing correlations.'
4709 & 'ERROR!!!! message length changed while processing correlations.'
4710 call mp_stopall(Error)
4711 endif ! msglen.eq.msglen1
4712 endif ! MyRank.lt.fgProcs-1
4719 write (iout,'(a)') 'Contact function values:'
4721 write (iout,'(2i3,50(1x,i2,f5.2))')
4722 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4723 & j=1,num_cont_hb(i))
4727 C Remove the loop below after debugging !!!
4734 C Calculate the local-electrostatic correlation terms
4735 do i=iatel_s,iatel_e+1
4737 num_conti=num_cont_hb(i)
4738 num_conti1=num_cont_hb(i+1)
4743 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4744 c & ' jj=',jj,' kk=',kk
4745 if (j1.eq.j+1 .or. j1.eq.j-1) then
4746 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4747 C The system gains extra energy.
4748 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4750 else if (j1.eq.j) then
4751 C Contacts I-J and I-(J+1) occur simultaneously.
4752 C The system loses extra energy.
4753 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4758 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4759 c & ' jj=',jj,' kk=',kk
4761 C Contacts I-J and (I+1)-J occur simultaneously.
4762 C The system loses extra energy.
4763 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4770 c------------------------------------------------------------------------------
4771 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4773 C This subroutine calculates multi-body contributions to hydrogen-bonding
4774 implicit real*8 (a-h,o-z)
4775 include 'DIMENSIONS'
4776 include 'sizesclu.dat'
4777 include 'COMMON.IOUNITS'
4779 include 'COMMON.INFO'
4781 include 'COMMON.FFIELD'
4782 include 'COMMON.DERIV'
4783 include 'COMMON.INTERACT'
4784 include 'COMMON.CONTACTS'
4786 parameter (max_cont=maxconts)
4787 parameter (max_dim=2*(8*3+2))
4788 parameter (msglen1=max_cont*max_dim*4)
4789 parameter (msglen2=2*msglen1)
4790 integer source,CorrelType,CorrelID,Error
4791 double precision buffer(max_cont,max_dim)
4793 double precision gx(3),gx1(3)
4796 C Set lprn=.true. for debugging
4802 if (fgProcs.le.1) goto 30
4804 write (iout,'(a)') 'Contact function values:'
4806 write (iout,'(2i3,50(1x,i2,f5.2))')
4807 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4808 & j=1,num_cont_hb(i))
4811 C Caution! Following code assumes that electrostatic interactions concerning
4812 C a given atom are split among at most two processors!
4822 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4825 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4826 if (MyRank.gt.0) then
4827 C Send correlation contributions to the preceding processor
4829 nn=num_cont_hb(iatel_s)
4830 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4831 cd write (iout,*) 'The BUFFER array:'
4833 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4835 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4837 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4838 C Clear the contacts of the atom passed to the neighboring processor
4839 nn=num_cont_hb(iatel_s+1)
4841 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4843 num_cont_hb(iatel_s)=0
4845 cd write (iout,*) 'Processor ',MyID,MyRank,
4846 cd & ' is sending correlation contribution to processor',MyID-1,
4847 cd & ' msglen=',msglen
4848 cd write (*,*) 'Processor ',MyID,MyRank,
4849 cd & ' is sending correlation contribution to processor',MyID-1,
4850 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4851 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4852 cd write (iout,*) 'Processor ',MyID,
4853 cd & ' has sent correlation contribution to processor',MyID-1,
4854 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4855 cd write (*,*) 'Processor ',MyID,
4856 cd & ' has sent correlation contribution to processor',MyID-1,
4857 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4859 endif ! (MyRank.gt.0)
4863 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4864 if (MyRank.lt.fgProcs-1) then
4865 C Receive correlation contributions from the next processor
4867 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4868 cd write (iout,*) 'Processor',MyID,
4869 cd & ' is receiving correlation contribution from processor',MyID+1,
4870 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4871 cd write (*,*) 'Processor',MyID,
4872 cd & ' is receiving correlation contribution from processor',MyID+1,
4873 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4875 do while (nbytes.le.0)
4876 call mp_probe(MyID+1,CorrelType,nbytes)
4878 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4879 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4880 cd write (iout,*) 'Processor',MyID,
4881 cd & ' has received correlation contribution from processor',MyID+1,
4882 cd & ' msglen=',msglen,' nbytes=',nbytes
4883 cd write (iout,*) 'The received BUFFER array:'
4885 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4887 if (msglen.eq.msglen1) then
4888 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4889 else if (msglen.eq.msglen2) then
4890 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4891 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4894 & 'ERROR!!!! message length changed while processing correlations.'
4896 & 'ERROR!!!! message length changed while processing correlations.'
4897 call mp_stopall(Error)
4898 endif ! msglen.eq.msglen1
4899 endif ! MyRank.lt.fgProcs-1
4906 write (iout,'(a)') 'Contact function values:'
4908 write (iout,'(2i3,50(1x,i2,f5.2))')
4909 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4910 & j=1,num_cont_hb(i))
4916 C Remove the loop below after debugging !!!
4923 C Calculate the dipole-dipole interaction energies
4924 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
4925 do i=iatel_s,iatel_e+1
4926 num_conti=num_cont_hb(i)
4933 C Calculate the local-electrostatic correlation terms
4934 do i=iatel_s,iatel_e+1
4936 num_conti=num_cont_hb(i)
4937 num_conti1=num_cont_hb(i+1)
4942 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4943 c & ' jj=',jj,' kk=',kk
4944 if (j1.eq.j+1 .or. j1.eq.j-1) then
4945 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4946 C The system gains extra energy.
4948 sqd1=dsqrt(d_cont(jj,i))
4949 sqd2=dsqrt(d_cont(kk,i1))
4950 sred_geom = sqd1*sqd2
4951 IF (sred_geom.lt.cutoff_corr) THEN
4952 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
4954 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4955 c & ' jj=',jj,' kk=',kk
4956 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
4957 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
4959 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
4960 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
4963 cd write (iout,*) 'sred_geom=',sred_geom,
4964 cd & ' ekont=',ekont,' fprim=',fprimcont
4965 call calc_eello(i,j,i+1,j1,jj,kk)
4966 if (wcorr4.gt.0.0d0)
4967 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
4968 if (wcorr5.gt.0.0d0)
4969 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
4970 c print *,"wcorr5",ecorr5
4971 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
4972 cd write(2,*)'ijkl',i,j,i+1,j1
4973 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
4974 & .or. wturn6.eq.0.0d0))then
4975 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
4976 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
4977 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
4978 cd & 'ecorr6=',ecorr6
4979 cd write (iout,'(4e15.5)') sred_geom,
4980 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
4981 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
4982 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
4983 else if (wturn6.gt.0.0d0
4984 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
4985 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
4986 eturn6=eturn6+eello_turn6(i,jj,kk)
4987 cd write (2,*) 'multibody_eello:eturn6',eturn6
4991 else if (j1.eq.j) then
4992 C Contacts I-J and I-(J+1) occur simultaneously.
4993 C The system loses extra energy.
4994 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4999 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5000 c & ' jj=',jj,' kk=',kk
5002 C Contacts I-J and (I+1)-J occur simultaneously.
5003 C The system loses extra energy.
5004 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5011 c------------------------------------------------------------------------------
5012 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5013 implicit real*8 (a-h,o-z)
5014 include 'DIMENSIONS'
5015 include 'COMMON.IOUNITS'
5016 include 'COMMON.DERIV'
5017 include 'COMMON.INTERACT'
5018 include 'COMMON.CONTACTS'
5019 double precision gx(3),gx1(3)
5029 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5030 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5031 C Following 4 lines for diagnostics.
5036 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5038 c write (iout,*)'Contacts have occurred for peptide groups',
5039 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5040 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5041 C Calculate the multi-body contribution to energy.
5042 ecorr=ecorr+ekont*ees
5044 C Calculate multi-body contributions to the gradient.
5046 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5047 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5048 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5049 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5050 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5051 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5052 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5053 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5054 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5055 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5056 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5057 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5058 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5059 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5063 gradcorr(ll,m)=gradcorr(ll,m)+
5064 & ees*ekl*gacont_hbr(ll,jj,i)-
5065 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5066 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5071 gradcorr(ll,m)=gradcorr(ll,m)+
5072 & ees*eij*gacont_hbr(ll,kk,k)-
5073 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5074 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5081 C---------------------------------------------------------------------------
5082 subroutine dipole(i,j,jj)
5083 implicit real*8 (a-h,o-z)
5084 include 'DIMENSIONS'
5085 include 'sizesclu.dat'
5086 include 'COMMON.IOUNITS'
5087 include 'COMMON.CHAIN'
5088 include 'COMMON.FFIELD'
5089 include 'COMMON.DERIV'
5090 include 'COMMON.INTERACT'
5091 include 'COMMON.CONTACTS'
5092 include 'COMMON.TORSION'
5093 include 'COMMON.VAR'
5094 include 'COMMON.GEO'
5095 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5097 iti1 = itortyp(itype(i+1))
5098 if (j.lt.nres-1) then
5099 itj1 = itortyp(itype(j+1))
5104 dipi(iii,1)=Ub2(iii,i)
5105 dipderi(iii)=Ub2der(iii,i)
5106 dipi(iii,2)=b1(iii,iti1)
5107 dipj(iii,1)=Ub2(iii,j)
5108 dipderj(iii)=Ub2der(iii,j)
5109 dipj(iii,2)=b1(iii,itj1)
5113 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5116 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5119 if (.not.calc_grad) return
5124 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5128 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5133 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5134 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5136 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5138 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5140 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5144 C---------------------------------------------------------------------------
5145 subroutine calc_eello(i,j,k,l,jj,kk)
5147 C This subroutine computes matrices and vectors needed to calculate
5148 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5150 implicit real*8 (a-h,o-z)
5151 include 'DIMENSIONS'
5152 include 'sizesclu.dat'
5153 include 'COMMON.IOUNITS'
5154 include 'COMMON.CHAIN'
5155 include 'COMMON.DERIV'
5156 include 'COMMON.INTERACT'
5157 include 'COMMON.CONTACTS'
5158 include 'COMMON.TORSION'
5159 include 'COMMON.VAR'
5160 include 'COMMON.GEO'
5161 include 'COMMON.FFIELD'
5162 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5163 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5166 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5167 cd & ' jj=',jj,' kk=',kk
5168 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5171 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5172 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5175 call transpose2(aa1(1,1),aa1t(1,1))
5176 call transpose2(aa2(1,1),aa2t(1,1))
5179 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5180 & aa1tder(1,1,lll,kkk))
5181 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5182 & aa2tder(1,1,lll,kkk))
5186 C parallel orientation of the two CA-CA-CA frames.
5188 iti=itortyp(itype(i))
5192 itk1=itortyp(itype(k+1))
5193 itj=itortyp(itype(j))
5194 if (l.lt.nres-1) then
5195 itl1=itortyp(itype(l+1))
5199 C A1 kernel(j+1) A2T
5201 cd write (iout,'(3f10.5,5x,3f10.5)')
5202 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5204 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5205 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5206 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5207 C Following matrices are needed only for 6-th order cumulants
5208 IF (wcorr6.gt.0.0d0) THEN
5209 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5210 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5211 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5212 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5213 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5214 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5215 & ADtEAderx(1,1,1,1,1,1))
5217 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5218 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5219 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5220 & ADtEA1derx(1,1,1,1,1,1))
5222 C End 6-th order cumulants
5225 cd write (2,*) 'In calc_eello6'
5227 cd write (2,*) 'iii=',iii
5229 cd write (2,*) 'kkk=',kkk
5231 cd write (2,'(3(2f10.5),5x)')
5232 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5237 call transpose2(EUgder(1,1,k),auxmat(1,1))
5238 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5239 call transpose2(EUg(1,1,k),auxmat(1,1))
5240 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5241 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5245 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5246 & EAEAderx(1,1,lll,kkk,iii,1))
5250 C A1T kernel(i+1) A2
5251 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5252 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5253 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5254 C Following matrices are needed only for 6-th order cumulants
5255 IF (wcorr6.gt.0.0d0) THEN
5256 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5257 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5258 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5259 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5260 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5261 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5262 & ADtEAderx(1,1,1,1,1,2))
5263 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5264 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5265 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5266 & ADtEA1derx(1,1,1,1,1,2))
5268 C End 6-th order cumulants
5269 call transpose2(EUgder(1,1,l),auxmat(1,1))
5270 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5271 call transpose2(EUg(1,1,l),auxmat(1,1))
5272 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5273 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5277 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5278 & EAEAderx(1,1,lll,kkk,iii,2))
5283 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5284 C They are needed only when the fifth- or the sixth-order cumulants are
5286 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5287 call transpose2(AEA(1,1,1),auxmat(1,1))
5288 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5289 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5290 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5291 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5292 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5293 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5294 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5295 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5296 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5297 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5298 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5299 call transpose2(AEA(1,1,2),auxmat(1,1))
5300 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5301 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5302 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5303 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5304 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5305 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5306 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5307 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5308 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5309 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5310 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5311 C Calculate the Cartesian derivatives of the vectors.
5315 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5316 call matvec2(auxmat(1,1),b1(1,iti),
5317 & AEAb1derx(1,lll,kkk,iii,1,1))
5318 call matvec2(auxmat(1,1),Ub2(1,i),
5319 & AEAb2derx(1,lll,kkk,iii,1,1))
5320 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5321 & AEAb1derx(1,lll,kkk,iii,2,1))
5322 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5323 & AEAb2derx(1,lll,kkk,iii,2,1))
5324 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5325 call matvec2(auxmat(1,1),b1(1,itj),
5326 & AEAb1derx(1,lll,kkk,iii,1,2))
5327 call matvec2(auxmat(1,1),Ub2(1,j),
5328 & AEAb2derx(1,lll,kkk,iii,1,2))
5329 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5330 & AEAb1derx(1,lll,kkk,iii,2,2))
5331 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5332 & AEAb2derx(1,lll,kkk,iii,2,2))
5339 C Antiparallel orientation of the two CA-CA-CA frames.
5341 iti=itortyp(itype(i))
5345 itk1=itortyp(itype(k+1))
5346 itl=itortyp(itype(l))
5347 itj=itortyp(itype(j))
5348 if (j.lt.nres-1) then
5349 itj1=itortyp(itype(j+1))
5353 C A2 kernel(j-1)T A1T
5354 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5355 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5356 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5357 C Following matrices are needed only for 6-th order cumulants
5358 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5359 & j.eq.i+4 .and. l.eq.i+3)) THEN
5360 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5361 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5362 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5363 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5364 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5365 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5366 & ADtEAderx(1,1,1,1,1,1))
5367 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5368 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5369 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5370 & ADtEA1derx(1,1,1,1,1,1))
5372 C End 6-th order cumulants
5373 call transpose2(EUgder(1,1,k),auxmat(1,1))
5374 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5375 call transpose2(EUg(1,1,k),auxmat(1,1))
5376 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5377 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5381 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5382 & EAEAderx(1,1,lll,kkk,iii,1))
5386 C A2T kernel(i+1)T A1
5387 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5388 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5389 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5390 C Following matrices are needed only for 6-th order cumulants
5391 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5392 & j.eq.i+4 .and. l.eq.i+3)) THEN
5393 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5394 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5395 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5396 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5397 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5398 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5399 & ADtEAderx(1,1,1,1,1,2))
5400 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5401 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5402 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5403 & ADtEA1derx(1,1,1,1,1,2))
5405 C End 6-th order cumulants
5406 call transpose2(EUgder(1,1,j),auxmat(1,1))
5407 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5408 call transpose2(EUg(1,1,j),auxmat(1,1))
5409 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5410 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5414 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5415 & EAEAderx(1,1,lll,kkk,iii,2))
5420 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5421 C They are needed only when the fifth- or the sixth-order cumulants are
5423 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5424 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5425 call transpose2(AEA(1,1,1),auxmat(1,1))
5426 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5427 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5428 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5429 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5430 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5431 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5432 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5433 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5434 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5435 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5436 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5437 call transpose2(AEA(1,1,2),auxmat(1,1))
5438 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5439 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5440 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5441 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5442 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5443 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5444 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5445 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5446 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5447 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5448 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5449 C Calculate the Cartesian derivatives of the vectors.
5453 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5454 call matvec2(auxmat(1,1),b1(1,iti),
5455 & AEAb1derx(1,lll,kkk,iii,1,1))
5456 call matvec2(auxmat(1,1),Ub2(1,i),
5457 & AEAb2derx(1,lll,kkk,iii,1,1))
5458 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5459 & AEAb1derx(1,lll,kkk,iii,2,1))
5460 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5461 & AEAb2derx(1,lll,kkk,iii,2,1))
5462 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5463 call matvec2(auxmat(1,1),b1(1,itl),
5464 & AEAb1derx(1,lll,kkk,iii,1,2))
5465 call matvec2(auxmat(1,1),Ub2(1,l),
5466 & AEAb2derx(1,lll,kkk,iii,1,2))
5467 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5468 & AEAb1derx(1,lll,kkk,iii,2,2))
5469 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5470 & AEAb2derx(1,lll,kkk,iii,2,2))
5479 C---------------------------------------------------------------------------
5480 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5481 & KK,KKderg,AKA,AKAderg,AKAderx)
5485 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5486 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5487 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5492 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5494 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5497 cd if (lprn) write (2,*) 'In kernel'
5499 cd if (lprn) write (2,*) 'kkk=',kkk
5501 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5502 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5504 cd write (2,*) 'lll=',lll
5505 cd write (2,*) 'iii=1'
5507 cd write (2,'(3(2f10.5),5x)')
5508 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5511 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5512 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5514 cd write (2,*) 'lll=',lll
5515 cd write (2,*) 'iii=2'
5517 cd write (2,'(3(2f10.5),5x)')
5518 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5525 C---------------------------------------------------------------------------
5526 double precision function eello4(i,j,k,l,jj,kk)
5527 implicit real*8 (a-h,o-z)
5528 include 'DIMENSIONS'
5529 include 'sizesclu.dat'
5530 include 'COMMON.IOUNITS'
5531 include 'COMMON.CHAIN'
5532 include 'COMMON.DERIV'
5533 include 'COMMON.INTERACT'
5534 include 'COMMON.CONTACTS'
5535 include 'COMMON.TORSION'
5536 include 'COMMON.VAR'
5537 include 'COMMON.GEO'
5538 double precision pizda(2,2),ggg1(3),ggg2(3)
5539 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5543 cd print *,'eello4:',i,j,k,l,jj,kk
5544 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5545 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5546 cold eij=facont_hb(jj,i)
5547 cold ekl=facont_hb(kk,k)
5549 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5551 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5552 gcorr_loc(k-1)=gcorr_loc(k-1)
5553 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5555 gcorr_loc(l-1)=gcorr_loc(l-1)
5556 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5558 gcorr_loc(j-1)=gcorr_loc(j-1)
5559 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5564 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5565 & -EAEAderx(2,2,lll,kkk,iii,1)
5566 cd derx(lll,kkk,iii)=0.0d0
5570 cd gcorr_loc(l-1)=0.0d0
5571 cd gcorr_loc(j-1)=0.0d0
5572 cd gcorr_loc(k-1)=0.0d0
5574 cd write (iout,*)'Contacts have occurred for peptide groups',
5575 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5576 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5577 if (j.lt.nres-1) then
5584 if (l.lt.nres-1) then
5592 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5593 ggg1(ll)=eel4*g_contij(ll,1)
5594 ggg2(ll)=eel4*g_contij(ll,2)
5595 ghalf=0.5d0*ggg1(ll)
5597 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5598 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5599 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5600 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5601 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5602 ghalf=0.5d0*ggg2(ll)
5604 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5605 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5606 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5607 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5612 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5613 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5618 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5619 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5625 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5630 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5634 cd write (2,*) iii,gcorr_loc(iii)
5638 cd write (2,*) 'ekont',ekont
5639 cd write (iout,*) 'eello4',ekont*eel4
5642 C---------------------------------------------------------------------------
5643 double precision function eello5(i,j,k,l,jj,kk)
5644 implicit real*8 (a-h,o-z)
5645 include 'DIMENSIONS'
5646 include 'sizesclu.dat'
5647 include 'COMMON.IOUNITS'
5648 include 'COMMON.CHAIN'
5649 include 'COMMON.DERIV'
5650 include 'COMMON.INTERACT'
5651 include 'COMMON.CONTACTS'
5652 include 'COMMON.TORSION'
5653 include 'COMMON.VAR'
5654 include 'COMMON.GEO'
5655 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5656 double precision ggg1(3),ggg2(3)
5657 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5662 C /l\ / \ \ / \ / \ / C
5663 C / \ / \ \ / \ / \ / C
5664 C j| o |l1 | o | o| o | | o |o C
5665 C \ |/k\| |/ \| / |/ \| |/ \| C
5666 C \i/ \ / \ / / \ / \ C
5668 C (I) (II) (III) (IV) C
5670 C eello5_1 eello5_2 eello5_3 eello5_4 C
5672 C Antiparallel chains C
5675 C /j\ / \ \ / \ / \ / C
5676 C / \ / \ \ / \ / \ / C
5677 C j1| o |l | o | o| o | | o |o C
5678 C \ |/k\| |/ \| / |/ \| |/ \| C
5679 C \i/ \ / \ / / \ / \ C
5681 C (I) (II) (III) (IV) C
5683 C eello5_1 eello5_2 eello5_3 eello5_4 C
5685 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5687 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5688 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5693 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5695 itk=itortyp(itype(k))
5696 itl=itortyp(itype(l))
5697 itj=itortyp(itype(j))
5702 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5703 cd & eel5_3_num,eel5_4_num)
5707 derx(lll,kkk,iii)=0.0d0
5711 cd eij=facont_hb(jj,i)
5712 cd ekl=facont_hb(kk,k)
5714 cd write (iout,*)'Contacts have occurred for peptide groups',
5715 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5717 C Contribution from the graph I.
5718 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5719 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5720 call transpose2(EUg(1,1,k),auxmat(1,1))
5721 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5722 vv(1)=pizda(1,1)-pizda(2,2)
5723 vv(2)=pizda(1,2)+pizda(2,1)
5724 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5725 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5727 C Explicit gradient in virtual-dihedral angles.
5728 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5729 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5730 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5731 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5732 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5733 vv(1)=pizda(1,1)-pizda(2,2)
5734 vv(2)=pizda(1,2)+pizda(2,1)
5735 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5736 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5737 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5738 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5739 vv(1)=pizda(1,1)-pizda(2,2)
5740 vv(2)=pizda(1,2)+pizda(2,1)
5742 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5743 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5744 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5746 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5747 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5748 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5750 C Cartesian gradient
5754 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5756 vv(1)=pizda(1,1)-pizda(2,2)
5757 vv(2)=pizda(1,2)+pizda(2,1)
5758 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5759 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5760 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5767 C Contribution from graph II
5768 call transpose2(EE(1,1,itk),auxmat(1,1))
5769 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5770 vv(1)=pizda(1,1)+pizda(2,2)
5771 vv(2)=pizda(2,1)-pizda(1,2)
5772 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5773 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5775 C Explicit gradient in virtual-dihedral angles.
5776 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5777 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5778 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5779 vv(1)=pizda(1,1)+pizda(2,2)
5780 vv(2)=pizda(2,1)-pizda(1,2)
5782 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5783 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5784 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5786 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5787 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5788 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5790 C Cartesian gradient
5794 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5796 vv(1)=pizda(1,1)+pizda(2,2)
5797 vv(2)=pizda(2,1)-pizda(1,2)
5798 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5799 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5800 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5809 C Parallel orientation
5810 C Contribution from graph III
5811 call transpose2(EUg(1,1,l),auxmat(1,1))
5812 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5813 vv(1)=pizda(1,1)-pizda(2,2)
5814 vv(2)=pizda(1,2)+pizda(2,1)
5815 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5816 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5818 C Explicit gradient in virtual-dihedral angles.
5819 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5820 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5821 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5822 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5823 vv(1)=pizda(1,1)-pizda(2,2)
5824 vv(2)=pizda(1,2)+pizda(2,1)
5825 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5826 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5827 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5828 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5829 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5830 vv(1)=pizda(1,1)-pizda(2,2)
5831 vv(2)=pizda(1,2)+pizda(2,1)
5832 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5833 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5834 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5835 C Cartesian gradient
5839 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5841 vv(1)=pizda(1,1)-pizda(2,2)
5842 vv(2)=pizda(1,2)+pizda(2,1)
5843 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5844 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5845 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5851 C Contribution from graph IV
5853 call transpose2(EE(1,1,itl),auxmat(1,1))
5854 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5855 vv(1)=pizda(1,1)+pizda(2,2)
5856 vv(2)=pizda(2,1)-pizda(1,2)
5857 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5858 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5860 C Explicit gradient in virtual-dihedral angles.
5861 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5862 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5863 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5864 vv(1)=pizda(1,1)+pizda(2,2)
5865 vv(2)=pizda(2,1)-pizda(1,2)
5866 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5867 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5868 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5869 C Cartesian gradient
5873 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5875 vv(1)=pizda(1,1)+pizda(2,2)
5876 vv(2)=pizda(2,1)-pizda(1,2)
5877 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5878 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5879 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5885 C Antiparallel orientation
5886 C Contribution from graph III
5888 call transpose2(EUg(1,1,j),auxmat(1,1))
5889 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5890 vv(1)=pizda(1,1)-pizda(2,2)
5891 vv(2)=pizda(1,2)+pizda(2,1)
5892 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
5893 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5895 C Explicit gradient in virtual-dihedral angles.
5896 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5897 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
5898 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
5899 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5900 vv(1)=pizda(1,1)-pizda(2,2)
5901 vv(2)=pizda(1,2)+pizda(2,1)
5902 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5903 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
5904 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
5905 call transpose2(EUgder(1,1,j),auxmat1(1,1))
5906 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5907 vv(1)=pizda(1,1)-pizda(2,2)
5908 vv(2)=pizda(1,2)+pizda(2,1)
5909 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5910 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
5911 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
5912 C Cartesian gradient
5916 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5918 vv(1)=pizda(1,1)-pizda(2,2)
5919 vv(2)=pizda(1,2)+pizda(2,1)
5920 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
5921 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
5922 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5928 C Contribution from graph IV
5930 call transpose2(EE(1,1,itj),auxmat(1,1))
5931 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5932 vv(1)=pizda(1,1)+pizda(2,2)
5933 vv(2)=pizda(2,1)-pizda(1,2)
5934 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
5935 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
5937 C Explicit gradient in virtual-dihedral angles.
5938 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5939 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
5940 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5941 vv(1)=pizda(1,1)+pizda(2,2)
5942 vv(2)=pizda(2,1)-pizda(1,2)
5943 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5944 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
5945 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
5946 C Cartesian gradient
5950 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5952 vv(1)=pizda(1,1)+pizda(2,2)
5953 vv(2)=pizda(2,1)-pizda(1,2)
5954 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
5955 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
5956 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
5963 eel5=eello5_1+eello5_2+eello5_3+eello5_4
5964 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
5965 cd write (2,*) 'ijkl',i,j,k,l
5966 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
5967 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
5969 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
5970 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
5971 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
5972 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
5974 if (j.lt.nres-1) then
5981 if (l.lt.nres-1) then
5991 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
5993 ggg1(ll)=eel5*g_contij(ll,1)
5994 ggg2(ll)=eel5*g_contij(ll,2)
5995 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
5996 ghalf=0.5d0*ggg1(ll)
5998 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
5999 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6000 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6001 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6002 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6003 ghalf=0.5d0*ggg2(ll)
6005 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6006 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6007 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6008 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6013 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6014 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6019 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6020 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6026 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6031 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6035 cd write (2,*) iii,g_corr5_loc(iii)
6039 cd write (2,*) 'ekont',ekont
6040 cd write (iout,*) 'eello5',ekont*eel5
6043 c--------------------------------------------------------------------------
6044 double precision function eello6(i,j,k,l,jj,kk)
6045 implicit real*8 (a-h,o-z)
6046 include 'DIMENSIONS'
6047 include 'sizesclu.dat'
6048 include 'COMMON.IOUNITS'
6049 include 'COMMON.CHAIN'
6050 include 'COMMON.DERIV'
6051 include 'COMMON.INTERACT'
6052 include 'COMMON.CONTACTS'
6053 include 'COMMON.TORSION'
6054 include 'COMMON.VAR'
6055 include 'COMMON.GEO'
6056 include 'COMMON.FFIELD'
6057 double precision ggg1(3),ggg2(3)
6058 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6063 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6071 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6072 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6076 derx(lll,kkk,iii)=0.0d0
6080 cd eij=facont_hb(jj,i)
6081 cd ekl=facont_hb(kk,k)
6087 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6088 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6089 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6090 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6091 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6092 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6094 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6095 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6096 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6097 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6098 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6099 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6103 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6105 C If turn contributions are considered, they will be handled separately.
6106 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6107 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6108 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6109 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6110 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6111 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6112 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6115 if (j.lt.nres-1) then
6122 if (l.lt.nres-1) then
6130 ggg1(ll)=eel6*g_contij(ll,1)
6131 ggg2(ll)=eel6*g_contij(ll,2)
6132 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6133 ghalf=0.5d0*ggg1(ll)
6135 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6136 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6137 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6138 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6139 ghalf=0.5d0*ggg2(ll)
6140 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6142 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6143 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6144 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6145 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6150 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6151 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6156 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6157 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6163 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6168 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6172 cd write (2,*) iii,g_corr6_loc(iii)
6176 cd write (2,*) 'ekont',ekont
6177 cd write (iout,*) 'eello6',ekont*eel6
6180 c--------------------------------------------------------------------------
6181 double precision function eello6_graph1(i,j,k,l,imat,swap)
6182 implicit real*8 (a-h,o-z)
6183 include 'DIMENSIONS'
6184 include 'sizesclu.dat'
6185 include 'COMMON.IOUNITS'
6186 include 'COMMON.CHAIN'
6187 include 'COMMON.DERIV'
6188 include 'COMMON.INTERACT'
6189 include 'COMMON.CONTACTS'
6190 include 'COMMON.TORSION'
6191 include 'COMMON.VAR'
6192 include 'COMMON.GEO'
6193 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6197 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6199 C Parallel Antiparallel C
6205 C \ j|/k\| / \ |/k\|l / C
6210 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6211 itk=itortyp(itype(k))
6212 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6213 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6214 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6215 call transpose2(EUgC(1,1,k),auxmat(1,1))
6216 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6217 vv1(1)=pizda1(1,1)-pizda1(2,2)
6218 vv1(2)=pizda1(1,2)+pizda1(2,1)
6219 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6220 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6221 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6222 s5=scalar2(vv(1),Dtobr2(1,i))
6223 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6224 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6225 if (.not. calc_grad) return
6226 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6227 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6228 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6229 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6230 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6231 & +scalar2(vv(1),Dtobr2der(1,i)))
6232 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6233 vv1(1)=pizda1(1,1)-pizda1(2,2)
6234 vv1(2)=pizda1(1,2)+pizda1(2,1)
6235 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6236 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6238 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6239 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6240 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6241 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6242 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6244 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6245 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6246 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6247 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6248 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6250 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6251 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6252 vv1(1)=pizda1(1,1)-pizda1(2,2)
6253 vv1(2)=pizda1(1,2)+pizda1(2,1)
6254 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6255 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6256 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6257 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6266 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6267 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6268 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6269 call transpose2(EUgC(1,1,k),auxmat(1,1))
6270 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6272 vv1(1)=pizda1(1,1)-pizda1(2,2)
6273 vv1(2)=pizda1(1,2)+pizda1(2,1)
6274 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6275 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6276 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6277 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6278 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6279 s5=scalar2(vv(1),Dtobr2(1,i))
6280 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6286 c----------------------------------------------------------------------------
6287 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6288 implicit real*8 (a-h,o-z)
6289 include 'DIMENSIONS'
6290 include 'sizesclu.dat'
6291 include 'COMMON.IOUNITS'
6292 include 'COMMON.CHAIN'
6293 include 'COMMON.DERIV'
6294 include 'COMMON.INTERACT'
6295 include 'COMMON.CONTACTS'
6296 include 'COMMON.TORSION'
6297 include 'COMMON.VAR'
6298 include 'COMMON.GEO'
6300 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6301 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6304 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6306 C Parallel Antiparallel C
6312 C \ j|/k\| \ |/k\|l C
6317 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6318 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6319 C AL 7/4/01 s1 would occur in the sixth-order moment,
6320 C but not in a cluster cumulant
6322 s1=dip(1,jj,i)*dip(1,kk,k)
6324 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6325 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6326 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6327 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6328 call transpose2(EUg(1,1,k),auxmat(1,1))
6329 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6330 vv(1)=pizda(1,1)-pizda(2,2)
6331 vv(2)=pizda(1,2)+pizda(2,1)
6332 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6333 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6335 eello6_graph2=-(s1+s2+s3+s4)
6337 eello6_graph2=-(s2+s3+s4)
6340 if (.not. calc_grad) return
6341 C Derivatives in gamma(i-1)
6344 s1=dipderg(1,jj,i)*dip(1,kk,k)
6346 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6347 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6348 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6349 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6351 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6353 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6355 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6357 C Derivatives in gamma(k-1)
6359 s1=dip(1,jj,i)*dipderg(1,kk,k)
6361 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6362 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6363 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6364 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6365 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6366 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6367 vv(1)=pizda(1,1)-pizda(2,2)
6368 vv(2)=pizda(1,2)+pizda(2,1)
6369 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6371 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6373 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6375 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6376 C Derivatives in gamma(j-1) or gamma(l-1)
6379 s1=dipderg(3,jj,i)*dip(1,kk,k)
6381 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6382 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6383 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6384 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6385 vv(1)=pizda(1,1)-pizda(2,2)
6386 vv(2)=pizda(1,2)+pizda(2,1)
6387 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6390 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6392 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6395 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6396 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6398 C Derivatives in gamma(l-1) or gamma(j-1)
6401 s1=dip(1,jj,i)*dipderg(3,kk,k)
6403 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6404 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6405 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6406 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6407 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6408 vv(1)=pizda(1,1)-pizda(2,2)
6409 vv(2)=pizda(1,2)+pizda(2,1)
6410 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6413 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6415 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6418 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6419 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6421 C Cartesian derivatives.
6423 write (2,*) 'In eello6_graph2'
6425 write (2,*) 'iii=',iii
6427 write (2,*) 'kkk=',kkk
6429 write (2,'(3(2f10.5),5x)')
6430 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6440 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6442 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6445 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6447 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6448 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6450 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6451 call transpose2(EUg(1,1,k),auxmat(1,1))
6452 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6454 vv(1)=pizda(1,1)-pizda(2,2)
6455 vv(2)=pizda(1,2)+pizda(2,1)
6456 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6457 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6459 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6461 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6464 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6466 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6473 c----------------------------------------------------------------------------
6474 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6475 implicit real*8 (a-h,o-z)
6476 include 'DIMENSIONS'
6477 include 'sizesclu.dat'
6478 include 'COMMON.IOUNITS'
6479 include 'COMMON.CHAIN'
6480 include 'COMMON.DERIV'
6481 include 'COMMON.INTERACT'
6482 include 'COMMON.CONTACTS'
6483 include 'COMMON.TORSION'
6484 include 'COMMON.VAR'
6485 include 'COMMON.GEO'
6486 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6488 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6490 C Parallel Antiparallel C
6496 C j|/k\| / |/k\|l / C
6501 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6503 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6504 C energy moment and not to the cluster cumulant.
6505 iti=itortyp(itype(i))
6506 if (j.lt.nres-1) then
6507 itj1=itortyp(itype(j+1))
6511 itk=itortyp(itype(k))
6512 itk1=itortyp(itype(k+1))
6513 if (l.lt.nres-1) then
6514 itl1=itortyp(itype(l+1))
6519 s1=dip(4,jj,i)*dip(4,kk,k)
6521 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6522 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6523 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6524 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6525 call transpose2(EE(1,1,itk),auxmat(1,1))
6526 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6527 vv(1)=pizda(1,1)+pizda(2,2)
6528 vv(2)=pizda(2,1)-pizda(1,2)
6529 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6530 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6532 eello6_graph3=-(s1+s2+s3+s4)
6534 eello6_graph3=-(s2+s3+s4)
6537 if (.not. calc_grad) return
6538 C Derivatives in gamma(k-1)
6539 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6540 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6541 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6542 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6543 C Derivatives in gamma(l-1)
6544 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6545 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6546 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6547 vv(1)=pizda(1,1)+pizda(2,2)
6548 vv(2)=pizda(2,1)-pizda(1,2)
6549 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6550 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6551 C Cartesian derivatives.
6557 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6559 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6562 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6564 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6565 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6567 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6568 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6570 vv(1)=pizda(1,1)+pizda(2,2)
6571 vv(2)=pizda(2,1)-pizda(1,2)
6572 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6574 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6576 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6579 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6581 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6583 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6589 c----------------------------------------------------------------------------
6590 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6591 implicit real*8 (a-h,o-z)
6592 include 'DIMENSIONS'
6593 include 'sizesclu.dat'
6594 include 'COMMON.IOUNITS'
6595 include 'COMMON.CHAIN'
6596 include 'COMMON.DERIV'
6597 include 'COMMON.INTERACT'
6598 include 'COMMON.CONTACTS'
6599 include 'COMMON.TORSION'
6600 include 'COMMON.VAR'
6601 include 'COMMON.GEO'
6602 include 'COMMON.FFIELD'
6603 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6604 & auxvec1(2),auxmat1(2,2)
6606 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6608 C Parallel Antiparallel C
6614 C \ j|/k\| \ |/k\|l C
6619 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6621 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6622 C energy moment and not to the cluster cumulant.
6623 cd write (2,*) 'eello_graph4: wturn6',wturn6
6624 iti=itortyp(itype(i))
6625 itj=itortyp(itype(j))
6626 if (j.lt.nres-1) then
6627 itj1=itortyp(itype(j+1))
6631 itk=itortyp(itype(k))
6632 if (k.lt.nres-1) then
6633 itk1=itortyp(itype(k+1))
6637 itl=itortyp(itype(l))
6638 if (l.lt.nres-1) then
6639 itl1=itortyp(itype(l+1))
6643 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6644 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6645 cd & ' itl',itl,' itl1',itl1
6648 s1=dip(3,jj,i)*dip(3,kk,k)
6650 s1=dip(2,jj,j)*dip(2,kk,l)
6653 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6654 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6656 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6657 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6659 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6660 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6662 call transpose2(EUg(1,1,k),auxmat(1,1))
6663 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6664 vv(1)=pizda(1,1)-pizda(2,2)
6665 vv(2)=pizda(2,1)+pizda(1,2)
6666 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6667 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6669 eello6_graph4=-(s1+s2+s3+s4)
6671 eello6_graph4=-(s2+s3+s4)
6673 if (.not. calc_grad) return
6674 C Derivatives in gamma(i-1)
6678 s1=dipderg(2,jj,i)*dip(3,kk,k)
6680 s1=dipderg(4,jj,j)*dip(2,kk,l)
6683 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6685 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6686 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6688 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6689 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6691 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6692 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6693 cd write (2,*) 'turn6 derivatives'
6695 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6697 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6701 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6703 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6707 C Derivatives in gamma(k-1)
6710 s1=dip(3,jj,i)*dipderg(2,kk,k)
6712 s1=dip(2,jj,j)*dipderg(4,kk,l)
6715 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6716 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6718 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6719 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6721 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6722 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6724 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6725 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6726 vv(1)=pizda(1,1)-pizda(2,2)
6727 vv(2)=pizda(2,1)+pizda(1,2)
6728 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6729 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6731 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6733 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6737 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6739 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6742 C Derivatives in gamma(j-1) or gamma(l-1)
6743 if (l.eq.j+1 .and. l.gt.1) then
6744 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6745 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6746 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6747 vv(1)=pizda(1,1)-pizda(2,2)
6748 vv(2)=pizda(2,1)+pizda(1,2)
6749 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6750 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6751 else if (j.gt.1) then
6752 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6753 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6754 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6755 vv(1)=pizda(1,1)-pizda(2,2)
6756 vv(2)=pizda(2,1)+pizda(1,2)
6757 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6758 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6759 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6761 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6764 C Cartesian derivatives.
6771 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6773 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6777 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6779 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6783 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6785 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6787 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6788 & b1(1,itj1),auxvec(1))
6789 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6791 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6792 & b1(1,itl1),auxvec(1))
6793 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6795 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6797 vv(1)=pizda(1,1)-pizda(2,2)
6798 vv(2)=pizda(2,1)+pizda(1,2)
6799 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6801 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6803 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6806 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6809 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6812 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6814 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6816 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6820 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6822 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6825 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6827 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6835 c----------------------------------------------------------------------------
6836 double precision function eello_turn6(i,jj,kk)
6837 implicit real*8 (a-h,o-z)
6838 include 'DIMENSIONS'
6839 include 'sizesclu.dat'
6840 include 'COMMON.IOUNITS'
6841 include 'COMMON.CHAIN'
6842 include 'COMMON.DERIV'
6843 include 'COMMON.INTERACT'
6844 include 'COMMON.CONTACTS'
6845 include 'COMMON.TORSION'
6846 include 'COMMON.VAR'
6847 include 'COMMON.GEO'
6848 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6849 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6851 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6852 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6853 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6854 C the respective energy moment and not to the cluster cumulant.
6859 iti=itortyp(itype(i))
6860 itk=itortyp(itype(k))
6861 itk1=itortyp(itype(k+1))
6862 itl=itortyp(itype(l))
6863 itj=itortyp(itype(j))
6864 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6865 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6866 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6871 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6873 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6877 derx_turn(lll,kkk,iii)=0.0d0
6884 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6886 cd write (2,*) 'eello6_5',eello6_5
6888 call transpose2(AEA(1,1,1),auxmat(1,1))
6889 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
6890 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
6891 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
6895 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
6896 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
6897 s2 = scalar2(b1(1,itk),vtemp1(1))
6899 call transpose2(AEA(1,1,2),atemp(1,1))
6900 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
6901 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
6902 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
6906 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
6907 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
6908 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
6910 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
6911 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
6912 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
6913 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
6914 ss13 = scalar2(b1(1,itk),vtemp4(1))
6915 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
6919 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
6925 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
6927 C Derivatives in gamma(i+2)
6929 call transpose2(AEA(1,1,1),auxmatd(1,1))
6930 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
6931 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
6932 call transpose2(AEAderg(1,1,2),atempd(1,1))
6933 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
6934 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
6938 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
6939 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
6940 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
6946 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
6947 C Derivatives in gamma(i+3)
6949 call transpose2(AEA(1,1,1),auxmatd(1,1))
6950 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
6951 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
6952 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
6956 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
6957 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
6958 s2d = scalar2(b1(1,itk),vtemp1d(1))
6960 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
6961 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
6963 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
6965 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
6966 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
6967 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
6977 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
6978 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
6980 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
6981 & -0.5d0*ekont*(s2d+s12d)
6983 C Derivatives in gamma(i+4)
6984 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
6985 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
6986 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
6988 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
6989 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
6990 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7000 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7002 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7004 C Derivatives in gamma(i+5)
7006 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7007 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7008 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7012 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7013 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7014 s2d = scalar2(b1(1,itk),vtemp1d(1))
7016 call transpose2(AEA(1,1,2),atempd(1,1))
7017 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7018 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7022 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7023 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7025 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7026 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7027 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7037 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7038 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7040 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7041 & -0.5d0*ekont*(s2d+s12d)
7043 C Cartesian derivatives
7048 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7049 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7050 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7054 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7055 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7057 s2d = scalar2(b1(1,itk),vtemp1d(1))
7059 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7060 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7061 s8d = -(atempd(1,1)+atempd(2,2))*
7062 & scalar2(cc(1,1,itl),vtemp2(1))
7066 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7068 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7069 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7076 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7079 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7083 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7084 & - 0.5d0*(s8d+s12d)
7086 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7095 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7097 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7098 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7099 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7100 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7101 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7103 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7104 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7105 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7109 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7110 cd & 16*eel_turn6_num
7112 if (j.lt.nres-1) then
7119 if (l.lt.nres-1) then
7127 ggg1(ll)=eel_turn6*g_contij(ll,1)
7128 ggg2(ll)=eel_turn6*g_contij(ll,2)
7129 ghalf=0.5d0*ggg1(ll)
7131 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7132 & +ekont*derx_turn(ll,2,1)
7133 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7134 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7135 & +ekont*derx_turn(ll,4,1)
7136 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7137 ghalf=0.5d0*ggg2(ll)
7139 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7140 & +ekont*derx_turn(ll,2,2)
7141 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7142 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7143 & +ekont*derx_turn(ll,4,2)
7144 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7149 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7154 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7160 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7165 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7169 cd write (2,*) iii,g_corr6_loc(iii)
7172 eello_turn6=ekont*eel_turn6
7173 cd write (2,*) 'ekont',ekont
7174 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7177 crc-------------------------------------------------
7178 SUBROUTINE MATVEC2(A1,V1,V2)
7179 implicit real*8 (a-h,o-z)
7180 include 'DIMENSIONS'
7181 DIMENSION A1(2,2),V1(2),V2(2)
7185 c 3 VI=VI+A1(I,K)*V1(K)
7189 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7190 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7195 C---------------------------------------
7196 SUBROUTINE MATMAT2(A1,A2,A3)
7197 implicit real*8 (a-h,o-z)
7198 include 'DIMENSIONS'
7199 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7200 c DIMENSION AI3(2,2)
7204 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7210 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7211 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7212 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7213 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7221 c-------------------------------------------------------------------------
7222 double precision function scalar2(u,v)
7224 double precision u(2),v(2)
7227 scalar2=u(1)*v(1)+u(2)*v(2)
7231 C-----------------------------------------------------------------------------
7233 subroutine transpose2(a,at)
7235 double precision a(2,2),at(2,2)
7242 c--------------------------------------------------------------------------
7243 subroutine transpose(n,a,at)
7246 double precision a(n,n),at(n,n)
7254 C---------------------------------------------------------------------------
7255 subroutine prodmat3(a1,a2,kk,transp,prod)
7258 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7260 crc double precision auxmat(2,2),prod_(2,2)
7263 crc call transpose2(kk(1,1),auxmat(1,1))
7264 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7265 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7267 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7268 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7269 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7270 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7271 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7272 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7273 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7274 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7277 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7278 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7280 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7281 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7282 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7283 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7284 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7285 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7286 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7287 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7290 c call transpose2(a2(1,1),a2t(1,1))
7293 crc print *,((prod_(i,j),i=1,2),j=1,2)
7294 crc print *,((prod(i,j),i=1,2),j=1,2)
7298 C-----------------------------------------------------------------------------
7299 double precision function scalar(u,v)
7301 double precision u(3),v(3)