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,106) 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).
47 106 call emomo(evdw,evdw_p,evdw_m)
49 C Calculate electrostatic (H-bonding) energy of the main chain.
51 107 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
53 C Calculate excluded-volume interaction energy between peptide groups
56 call escp(evdw2,evdw2_14)
58 c Calculate the bond-stretching energy
61 c write (iout,*) "estr",estr
63 C Calculate the disulfide-bridge and other energy and the contributions
64 C from other distance constraints.
65 cd print *,'Calling EHPB'
67 cd print *,'EHPB exitted succesfully.'
69 C Calculate the virtual-bond-angle energy.
72 cd print *,'Bend energy finished.'
74 C Calculate the SC local energy.
77 cd print *,'SCLOC energy finished.'
79 C Calculate the virtual-bond torsional energy.
81 cd print *,'nterm=',nterm
82 call etor(etors,edihcnstr,fact(1))
84 C 6/23/01 Calculate double-torsional energy
86 call etor_d(etors_d,fact(2))
88 C 21/5/07 Calculate local sicdechain correlation energy
90 call eback_sc_corr(esccor,fact(1))
92 C 12/1/95 Multi-body terms
96 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
97 & .or. wturn6.gt.0.0d0) then
98 c print *,"calling multibody_eello"
99 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
100 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
101 c print *,ecorr,ecorr5,ecorr6,eturn6
103 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
104 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
106 C call multibody(ecorr)
111 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*ees+wvdwpp*evdw1
112 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
113 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
114 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
115 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
116 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
117 & +wbond*estr+wsccor*fact(1)*esccor
119 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*(ees+evdw1)
120 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
121 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
122 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
123 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
124 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
125 & +wbond*estr+wsccor*fact(1)*esccor
130 energia(2)=evdw2-evdw2_14
147 energia(8)=eello_turn3
148 energia(9)=eello_turn4
157 energia(20)=edihcnstr
161 idumm=proc_proc(etot,i)
163 call proc_proc(etot,i)
165 if(i.eq.1)energia(0)=1.0d+99
171 C Sum up the components of the Cartesian gradient.
176 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
177 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
179 & wstrain*ghpbc(j,i)+
180 & wcorr*fact(3)*gradcorr(j,i)+
181 & wel_loc*fact(2)*gel_loc(j,i)+
182 & wturn3*fact(2)*gcorr3_turn(j,i)+
183 & wturn4*fact(3)*gcorr4_turn(j,i)+
184 & wcorr5*fact(4)*gradcorr5(j,i)+
185 & wcorr6*fact(5)*gradcorr6(j,i)+
186 & wturn6*fact(5)*gcorr6_turn(j,i)+
187 & wsccor*fact(2)*gsccorc(j,i)
188 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
190 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
195 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
196 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
198 & wcorr*fact(3)*gradcorr(j,i)+
199 & wel_loc*fact(2)*gel_loc(j,i)+
200 & wturn3*fact(2)*gcorr3_turn(j,i)+
201 & wturn4*fact(3)*gcorr4_turn(j,i)+
202 & wcorr5*fact(4)*gradcorr5(j,i)+
203 & wcorr6*fact(5)*gradcorr6(j,i)+
204 & wturn6*fact(5)*gcorr6_turn(j,i)+
205 & wsccor*fact(2)*gsccorc(j,i)
206 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
208 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
211 cd print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3),
212 cd & (gradc(k,i),k=1,3)
217 cd write (iout,*) i,g_corr5_loc(i)
218 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
219 & +wcorr5*fact(4)*g_corr5_loc(i)
220 & +wcorr6*fact(5)*g_corr6_loc(i)
221 & +wturn4*fact(3)*gel_loc_turn4(i)
222 & +wturn3*fact(2)*gel_loc_turn3(i)
223 & +wturn6*fact(5)*gel_loc_turn6(i)
224 & +wel_loc*fact(2)*gel_loc_loc(i)+
225 & +wsccor*fact(1)*gsccor_loc(i)
228 cd call enerprint(energia(0),fact)
233 C------------------------------------------------------------------------
234 subroutine enerprint(energia,fact)
235 implicit real*8 (a-h,o-z)
237 include 'sizesclu.dat'
238 include 'COMMON.IOUNITS'
239 include 'COMMON.FFIELD'
240 include 'COMMON.SBRIDGE'
241 double precision energia(0:max_ene),fact(5)
245 evdw2=energia(2)+energia(17)
257 eello_turn3=energia(8)
258 eello_turn4=energia(9)
259 eello_turn6=energia(10)
266 edihcnstr=energia(20)
269 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
271 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
272 & etors_d,wtor_d*fact(2),ehpb,wstrain,
273 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
274 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
275 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
276 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
277 10 format (/'Virtual-chain energies:'//
278 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
279 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
280 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
281 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
282 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
283 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
284 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
285 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
286 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
287 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
288 & ' (SS bridges & dist. cnstr.)'/
289 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
290 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
291 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
292 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
293 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
294 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
295 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
296 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
297 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
298 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
299 & 'ETOT= ',1pE16.6,' (total)')
301 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
302 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
303 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
304 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
305 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
306 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
307 & edihcnstr,ebr*nss,etot
308 10 format (/'Virtual-chain energies:'//
309 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
310 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
311 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
312 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
313 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
314 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
315 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
316 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
317 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
318 & ' (SS bridges & dist. cnstr.)'/
319 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
320 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
321 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
322 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
323 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
324 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
325 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
326 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
327 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
328 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
329 & 'ETOT= ',1pE16.6,' (total)')
333 C-----------------------------------------------------------------------
336 C This subroutine calculates the interaction energy of nonbonded side chains
337 C assuming the LJ potential of interaction.
339 implicit real*8 (a-h,o-z)
341 include 'sizesclu.dat'
342 c include "DIMENSIONS.COMPAR"
343 parameter (accur=1.0d-10)
346 include 'COMMON.LOCAL'
347 include 'COMMON.CHAIN'
348 include 'COMMON.DERIV'
349 include 'COMMON.INTERACT'
350 include 'COMMON.TORSION'
351 include 'COMMON.SBRIDGE'
352 include 'COMMON.NAMES'
353 include 'COMMON.IOUNITS'
354 include 'COMMON.CONTACTS'
358 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
369 C Calculate SC interaction energy.
372 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
373 cd & 'iend=',iend(i,iint)
374 do j=istart(i,iint),iend(i,iint)
379 C Change 12/1/95 to calculate four-body interactions
380 rij=xj*xj+yj*yj+zj*zj
382 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
383 eps0ij=eps(itypi,itypj)
385 e1=fac*fac*aa(itypi,itypj)
386 e2=fac*bb(itypi,itypj)
388 ij=icant(itypi,itypj)
389 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
390 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
391 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
392 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
393 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
394 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
398 C Calculate the components of the gradient in DC and X
400 fac=-rrij*(e1+evdwij)
405 gvdwx(k,i)=gvdwx(k,i)-gg(k)
406 gvdwx(k,j)=gvdwx(k,j)+gg(k)
410 gvdwc(l,k)=gvdwc(l,k)+gg(l)
415 C 12/1/95, revised on 5/20/97
417 C Calculate the contact function. The ith column of the array JCONT will
418 C contain the numbers of atoms that make contacts with the atom I (of numbers
419 C greater than I). The arrays FACONT and GACONT will contain the values of
420 C the contact function and its derivative.
422 C Uncomment next line, if the correlation interactions include EVDW explicitly.
423 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
424 C Uncomment next line, if the correlation interactions are contact function only
425 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
427 sigij=sigma(itypi,itypj)
428 r0ij=rs0(itypi,itypj)
430 C Check whether the SC's are not too far to make a contact.
433 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
434 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
436 if (fcont.gt.0.0D0) then
437 C If the SC-SC distance if close to sigma, apply spline.
438 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
439 cAdam & fcont1,fprimcont1)
440 cAdam fcont1=1.0d0-fcont1
441 cAdam if (fcont1.gt.0.0d0) then
442 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
443 cAdam fcont=fcont*fcont1
445 C Uncomment following 4 lines to have the geometric average of the epsilon0's
446 cga eps0ij=1.0d0/dsqrt(eps0ij)
448 cga gg(k)=gg(k)*eps0ij
450 cga eps0ij=-evdwij*eps0ij
451 C Uncomment for AL's type of SC correlation interactions.
453 num_conti=num_conti+1
455 facont(num_conti,i)=fcont*eps0ij
456 fprimcont=eps0ij*fprimcont/rij
458 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
459 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
460 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
461 C Uncomment following 3 lines for Skolnick's type of SC correlation.
462 gacont(1,num_conti,i)=-fprimcont*xj
463 gacont(2,num_conti,i)=-fprimcont*yj
464 gacont(3,num_conti,i)=-fprimcont*zj
465 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
466 cd write (iout,'(2i3,3f10.5)')
467 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
473 num_cont(i)=num_conti
478 gvdwc(j,i)=expon*gvdwc(j,i)
479 gvdwx(j,i)=expon*gvdwx(j,i)
483 C******************************************************************************
487 C To save time, the factor of EXPON has been extracted from ALL components
488 C of GVDWC and GRADX. Remember to multiply them by this factor before further
491 C******************************************************************************
494 C-----------------------------------------------------------------------------
495 subroutine eljk(evdw)
497 C This subroutine calculates the interaction energy of nonbonded side chains
498 C assuming the LJK potential of interaction.
500 implicit real*8 (a-h,o-z)
502 include 'sizesclu.dat'
503 c include "DIMENSIONS.COMPAR"
506 include 'COMMON.LOCAL'
507 include 'COMMON.CHAIN'
508 include 'COMMON.DERIV'
509 include 'COMMON.INTERACT'
510 include 'COMMON.IOUNITS'
511 include 'COMMON.NAMES'
516 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
525 C Calculate SC interaction energy.
528 do j=istart(i,iint),iend(i,iint)
533 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
535 e_augm=augm(itypi,itypj)*fac_augm
538 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
539 fac=r_shift_inv**expon
540 e1=fac*fac*aa(itypi,itypj)
541 e2=fac*bb(itypi,itypj)
543 ij=icant(itypi,itypj)
544 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
545 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
546 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
547 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
548 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
549 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
550 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
554 C Calculate the components of the gradient in DC and X
556 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
561 gvdwx(k,i)=gvdwx(k,i)-gg(k)
562 gvdwx(k,j)=gvdwx(k,j)+gg(k)
566 gvdwc(l,k)=gvdwc(l,k)+gg(l)
576 gvdwc(j,i)=expon*gvdwc(j,i)
577 gvdwx(j,i)=expon*gvdwx(j,i)
583 C-----------------------------------------------------------------------------
586 C This subroutine calculates the interaction energy of nonbonded side chains
587 C assuming the Berne-Pechukas potential of interaction.
589 implicit real*8 (a-h,o-z)
591 include 'sizesclu.dat'
592 c include "DIMENSIONS.COMPAR"
595 include 'COMMON.LOCAL'
596 include 'COMMON.CHAIN'
597 include 'COMMON.DERIV'
598 include 'COMMON.NAMES'
599 include 'COMMON.INTERACT'
600 include 'COMMON.IOUNITS'
601 include 'COMMON.CALC'
603 c double precision rrsave(maxdim)
608 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
610 c if (icall.eq.0) then
622 dxi=dc_norm(1,nres+i)
623 dyi=dc_norm(2,nres+i)
624 dzi=dc_norm(3,nres+i)
625 dsci_inv=vbld_inv(i+nres)
627 C Calculate SC interaction energy.
630 do j=istart(i,iint),iend(i,iint)
633 dscj_inv=vbld_inv(j+nres)
634 chi1=chi(itypi,itypj)
635 chi2=chi(itypj,itypi)
642 alf12=0.5D0*(alf1+alf2)
643 C For diagnostics only!!!
656 dxj=dc_norm(1,nres+j)
657 dyj=dc_norm(2,nres+j)
658 dzj=dc_norm(3,nres+j)
659 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
660 cd if (icall.eq.0) then
666 C Calculate the angle-dependent terms of energy & contributions to derivatives.
668 C Calculate whole angle-dependent part of epsilon and contributions
670 fac=(rrij*sigsq)**expon2
671 e1=fac*fac*aa(itypi,itypj)
672 e2=fac*bb(itypi,itypj)
673 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
674 eps2der=evdwij*eps3rt
675 eps3der=evdwij*eps2rt
676 evdwij=evdwij*eps2rt*eps3rt
677 ij=icant(itypi,itypj)
678 aux=eps1*eps2rt**2*eps3rt**2
682 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
683 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
684 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
685 cd & restyp(itypi),i,restyp(itypj),j,
686 cd & epsi,sigm,chi1,chi2,chip1,chip2,
687 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
688 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
691 C Calculate gradient components.
692 e1=e1*eps1*eps2rt**2*eps3rt**2
693 fac=-expon*(e1+evdwij)
696 C Calculate radial part of the gradient
700 C Calculate the angular part of the gradient and sum add the contributions
701 C to the appropriate components of the Cartesian gradient.
710 C-----------------------------------------------------------------------------
713 C This subroutine calculates the interaction energy of nonbonded side chains
714 C assuming the Gay-Berne potential of interaction.
716 implicit real*8 (a-h,o-z)
718 include 'sizesclu.dat'
719 c include "DIMENSIONS.COMPAR"
722 include 'COMMON.LOCAL'
723 include 'COMMON.CHAIN'
724 include 'COMMON.DERIV'
725 include 'COMMON.NAMES'
726 include 'COMMON.INTERACT'
727 include 'COMMON.IOUNITS'
728 include 'COMMON.CALC'
734 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
737 c if (icall.gt.0) lprn=.true.
745 dxi=dc_norm(1,nres+i)
746 dyi=dc_norm(2,nres+i)
747 dzi=dc_norm(3,nres+i)
748 dsci_inv=vbld_inv(i+nres)
750 C Calculate SC interaction energy.
753 do j=istart(i,iint),iend(i,iint)
756 dscj_inv=vbld_inv(j+nres)
757 sig0ij=sigma(itypi,itypj)
758 chi1=chi(itypi,itypj)
759 chi2=chi(itypj,itypi)
766 alf12=0.5D0*(alf1+alf2)
767 C For diagnostics only!!!
780 dxj=dc_norm(1,nres+j)
781 dyj=dc_norm(2,nres+j)
782 dzj=dc_norm(3,nres+j)
783 c write (iout,*) i,j,xj,yj,zj
784 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
786 C Calculate angle-dependent terms of energy and contributions to their
790 sig=sig0ij*dsqrt(sigsq)
791 rij_shift=1.0D0/rij-sig+sig0ij
792 C I hate to put IF's in the loops, but here don't have another choice!!!!
793 if (rij_shift.le.0.0D0) then
798 c---------------------------------------------------------------
799 rij_shift=1.0D0/rij_shift
801 e1=fac*fac*aa(itypi,itypj)
802 e2=fac*bb(itypi,itypj)
803 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
804 eps2der=evdwij*eps3rt
805 eps3der=evdwij*eps2rt
806 evdwij=evdwij*eps2rt*eps3rt
808 ij=icant(itypi,itypj)
809 aux=eps1*eps2rt**2*eps3rt**2
810 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
811 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
812 c & aux*e2/eps(itypi,itypj)
814 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
815 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
816 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
817 & restyp(itypi),i,restyp(itypj),j,
818 & epsi,sigm,chi1,chi2,chip1,chip2,
819 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
820 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
824 C Calculate gradient components.
825 e1=e1*eps1*eps2rt**2*eps3rt**2
826 fac=-expon*(e1+evdwij)*rij_shift
829 C Calculate the radial part of the gradient
833 C Calculate angular part of the gradient.
841 C-----------------------------------------------------------------------------
842 subroutine egbv(evdw)
844 C This subroutine calculates the interaction energy of nonbonded side chains
845 C assuming the Gay-Berne-Vorobjev potential of interaction.
847 implicit real*8 (a-h,o-z)
849 include 'sizesclu.dat'
850 c include "DIMENSIONS.COMPAR"
853 include 'COMMON.LOCAL'
854 include 'COMMON.CHAIN'
855 include 'COMMON.DERIV'
856 include 'COMMON.NAMES'
857 include 'COMMON.INTERACT'
858 include 'COMMON.IOUNITS'
859 include 'COMMON.CALC'
865 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
868 c if (icall.gt.0) lprn=.true.
876 dxi=dc_norm(1,nres+i)
877 dyi=dc_norm(2,nres+i)
878 dzi=dc_norm(3,nres+i)
879 dsci_inv=vbld_inv(i+nres)
881 C Calculate SC interaction energy.
884 do j=istart(i,iint),iend(i,iint)
887 dscj_inv=vbld_inv(j+nres)
888 sig0ij=sigma(itypi,itypj)
890 chi1=chi(itypi,itypj)
891 chi2=chi(itypj,itypi)
898 alf12=0.5D0*(alf1+alf2)
899 C For diagnostics only!!!
912 dxj=dc_norm(1,nres+j)
913 dyj=dc_norm(2,nres+j)
914 dzj=dc_norm(3,nres+j)
915 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
917 C Calculate angle-dependent terms of energy and contributions to their
921 sig=sig0ij*dsqrt(sigsq)
922 rij_shift=1.0D0/rij-sig+r0ij
923 C I hate to put IF's in the loops, but here don't have another choice!!!!
924 if (rij_shift.le.0.0D0) then
929 c---------------------------------------------------------------
930 rij_shift=1.0D0/rij_shift
932 e1=fac*fac*aa(itypi,itypj)
933 e2=fac*bb(itypi,itypj)
934 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
935 eps2der=evdwij*eps3rt
936 eps3der=evdwij*eps2rt
938 e_augm=augm(itypi,itypj)*fac_augm
939 evdwij=evdwij*eps2rt*eps3rt
940 evdw=evdw+evdwij+e_augm
941 ij=icant(itypi,itypj)
942 aux=eps1*eps2rt**2*eps3rt**2
944 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
945 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
946 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
947 c & restyp(itypi),i,restyp(itypj),j,
948 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
949 c & chi1,chi2,chip1,chip2,
950 c & eps1,eps2rt**2,eps3rt**2,
951 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
955 C Calculate gradient components.
956 e1=e1*eps1*eps2rt**2*eps3rt**2
957 fac=-expon*(e1+evdwij)*rij_shift
959 fac=rij*fac-2*expon*rrij*e_augm
960 C Calculate the radial part of the gradient
964 C Calculate angular part of the gradient.
972 C-----------------------------------------------------------------------------
975 SUBROUTINE emomo(evdw,evdw_p,evdw_m)
977 C This subroutine calculates the interaction energy of nonbonded side chains
978 C assuming the Gay-Berne potential of interaction.
982 INCLUDE 'sizesclu.dat'
983 INCLUDE 'COMMON.CALC'
984 INCLUDE 'COMMON.CONTROL'
985 INCLUDE 'COMMON.CHAIN'
986 INCLUDE 'COMMON.DERIV'
989 INCLUDE 'COMMON.INTERACT'
990 INCLUDE 'COMMON.IOUNITS'
991 INCLUDE 'COMMON.LOCAL'
992 INCLUDE 'COMMON.NAMES'
995 double precision scalar
996 double precision ener(4)
1000 IF (energy_dec) write (iout,'(a)')
1001 & ' AAi i AAj j 1/rij Rtail Rhead evdwij Fcav Ecl
1002 & Egb Epol Fisocav Elj Equad evdw'
1007 ccccc energy_dec=.false.
1008 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1010 c if (icall.eq.0) lprn=.false.
1013 DO i = iatsc_s, iatsc_e
1015 c itypi1 = itype(i+1)
1016 dxi = dc_norm(1,nres+i)
1017 dyi = dc_norm(2,nres+i)
1018 dzi = dc_norm(3,nres+i)
1019 c dsci_inv=dsc_inv(itypi)
1020 dsci_inv = vbld_inv(i+nres)
1022 c ctail(k,1) = c(k, i+nres)
1023 c & - dtail(1,itypi,itypj) * dc_norm(k, nres+i)
1028 c!-------------------------------------------------------------------
1029 C Calculate SC interaction energy.
1030 DO iint = 1, nint_gr(i)
1031 DO j = istart(i,iint), iend(i,iint)
1032 c! initialize variables for electrostatic gradients
1033 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
1035 c dscj_inv = dsc_inv(itypj)
1036 dscj_inv = vbld_inv(j+nres)
1037 c! rij holds 1/(distance of Calpha atoms)
1038 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
1040 c!-------------------------------------------------------------------
1041 C Calculate angle-dependent terms of energy and contributions to their
1045 c! DO troll = 10, 5000
1049 c! sqom1 = om1 * om1
1050 c! sqom2 = om2 * om2
1051 c! sqom12 = om12 * om12
1052 c! rij = 5.0d0 / troll
1054 c! Rtail = troll / 5.0d0
1055 c! Rhead = troll / 5.0d0
1056 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1057 c! Rtail = dsqrt((Rtail**2)
1058 c! & +((dabs(dtail(1,itypi,itypj)-dtail(2,itypi,itypj)))**2))
1059 c! rij = 1.0d0/Rtail
1063 c! this should be in elgrad_init but om's are calculated by sc_angular
1064 c! which in turn is used by older potentials
1065 c! which proves how tangled UNRES code is >.<
1066 c! om = omega, sqom = om^2
1069 sqom12 = om12 * om12
1071 c! now we calculate EGB - Gey-Berne
1072 c! It will be summed up in evdwij and saved in evdw
1073 sigsq = 1.0D0 / sigsq
1074 sig = sig0ij * dsqrt(sigsq)
1075 c! rij_shift = 1.0D0 / rij - sig + sig0ij
1076 rij_shift = Rtail - sig + sig0ij
1077 c write (2,*) "Rtal",Rtail," sig",sig," sigsq",sigsq,
1078 c & " sig0ij",sig0ij
1079 c write (2,*) "rij_shift",rij_shift
1080 IF (rij_shift.le.0.0D0) THEN
1084 sigder = -sig * sigsq
1085 rij_shift = 1.0D0 / rij_shift
1086 fac = rij_shift**expon
1087 c1 = fac * fac * aa(itypi,itypj)
1089 c2 = fac * bb(itypi,itypj)
1091 c write (2,*) "eps1",eps1," eps2rt",eps2rt," eps3rt",eps3rt,
1092 c & " c1",c1," c2",c2
1093 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
1094 eps2der = eps3rt * evdwij
1095 eps3der = eps2rt * evdwij
1096 c! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
1097 evdwij = eps2rt * eps3rt * evdwij
1099 c! write (*,*) "Gey Berne = ", evdwij
1101 IF (bb(itypi,itypj).gt.0) THEN
1102 evdw_p = evdw_p + evdwij
1104 evdw_m = evdw_m + evdwij
1110 c!-------------------------------------------------------------------
1111 c! Calculate some components of GGB
1112 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
1113 fac = -expon * (c1 + evdwij) * rij_shift
1114 sigder = fac * sigder
1116 c! Calculate distance derivative
1123 c! write (*,*) "gg(1) = ", gg(1)
1124 c! write (*,*) "gg(2) = ", gg(2)
1125 c! write (*,*) "gg(3) = ", gg(3)
1126 c! The angular derivatives of GGB are brought together in sc_grad
1127 c!-------------------------------------------------------------------
1130 c! Catch gly-gly interactions to skip calculation of something that
1133 IF (itypi.eq.10.and.itypj.eq.10) THEN
1141 c! we are not 2 glycines, so we calculate Fcav (and maybe more)
1142 fac = chis1 * sqom1 + chis2 * sqom2
1143 & - 2.0d0 * chis12 * om1 * om2 * om12
1144 c! we will use pom later in Gcav, so dont mess with it!
1145 pom = 1.0d0 - chis1 * chis2 * sqom12
1147 Lambf = (1.0d0 - (fac / pom))
1148 Lambf = dsqrt(Lambf)
1151 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
1152 c! write (*,*) "sparrow = ", sparrow
1153 Chif = Rtail * sparrow
1154 ChiLambf = Chif * Lambf
1155 eagle = dsqrt(ChiLambf)
1156 bat = ChiLambf ** 11.0d0
1158 top = b1 * ( eagle + b2 * ChiLambf - b3 )
1159 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
1162 c! write (*,*) "sig1 = ",sig1
1163 c! write (*,*) "sig2 = ",sig2
1164 c! write (*,*) "Rtail = ",Rtail
1165 c! write (*,*) "sparrow = ",sparrow
1166 c! write (*,*) "Chis1 = ", chis1
1167 c! write (*,*) "Chis2 = ", chis2
1168 c! write (*,*) "Chis12 = ", chis12
1169 c! write (*,*) "om1 = ", om1
1170 c! write (*,*) "om2 = ", om2
1171 c! write (*,*) "om12 = ", om12
1172 c! write (*,*) "sqom1 = ", sqom1
1173 c! write (*,*) "sqom2 = ", sqom2
1174 c! write (*,*) "sqom12 = ", sqom12
1175 c! write (*,*) "Lambf = ",Lambf
1176 c! write (*,*) "b1 = ",b1
1177 c! write (*,*) "b2 = ",b2
1178 c! write (*,*) "b3 = ",b3
1179 c! write (*,*) "b4 = ",b4
1180 c! write (*,*) "top = ",top
1181 c! write (*,*) "bot = ",bot
1184 c! write (*,*) "Fcav = ", Fcav
1185 c!-------------------------------------------------------------------
1186 c! derivative of Fcav is Gcav...
1187 c!---------------------------------------------------
1189 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
1190 dbot = 12.0d0 * b4 * bat * Lambf
1191 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
1193 c! write (*,*) "dFcav/dR = ", dFdR
1195 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
1196 dbot = 12.0d0 * b4 * bat * Chif
1198 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
1199 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
1200 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2)
1201 & * (chis2 * om2 * om12 - om1) / (eagle * pom)
1203 dFdL = ((dtop * bot - top * dbot) / botsq)
1205 dCAVdOM1 = dFdL * ( dFdOM1 )
1206 dCAVdOM2 = dFdL * ( dFdOM2 )
1207 dCAVdOM12 = dFdL * ( dFdOM12 )
1208 c! write (*,*) "dFcav/dOM1 = ", dCAVdOM1
1209 c! write (*,*) "dFcav/dOM2 = ", dCAVdOM2
1210 c! write (*,*) "dFcav/dOM12 = ", dCAVdOM12
1212 c!-------------------------------------------------------------------
1213 c! Finally, add the distance derivatives of GB and Fcav to gvdwc
1214 c! Pom is used here to project the gradient vector into
1215 c! cartesian coordinates and at the same time contains
1216 c! dXhb/dXsc derivative (for charged amino acids
1217 c! location of hydrophobic centre of interaction is not
1218 c! the same as geometric centre of side chain, this
1219 c! derivative takes that into account)
1220 c! derivatives of omega angles will be added in sc_grad
1223 ertail(k) = Rtail_distance(k)/Rtail
1225 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
1226 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
1227 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1228 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1230 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1231 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1232 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
1233 gvdwx(k,i) = gvdwx(k,i)
1234 & - (( dFdR + gg(k) ) * pom)
1235 c! & - ( dFdR * pom )
1236 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
1237 gvdwx(k,j) = gvdwx(k,j)
1238 & + (( dFdR + gg(k) ) * pom)
1239 c! & + ( dFdR * pom )
1241 gvdwc(k,i) = gvdwc(k,i)
1242 & - (( dFdR + gg(k) ) * ertail(k))
1243 c! & - ( dFdR * ertail(k))
1245 gvdwc(k,j) = gvdwc(k,j)
1246 & + (( dFdR + gg(k) ) * ertail(k))
1247 c! & + ( dFdR * ertail(k))
1250 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1251 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1254 c!-------------------------------------------------------------------
1255 c! Compute head-head and head-tail energies for each state
1257 isel = iabs(Qi) + iabs(Qj)
1259 c! No charges - do nothing
1262 ELSE IF (isel.eq.4) THEN
1263 c! Calculate dipole-dipole interactions
1267 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
1268 c! Charge-nonpolar interactions
1272 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
1273 c! Nonpolar-charge interactions
1277 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
1278 c! Charge-dipole interactions
1279 CALL eqd(ecl, elj, epol)
1280 eheadtail = ECL + elj + epol
1282 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
1283 c! Dipole-charge interactions
1284 CALL edq(ecl, elj, epol)
1285 eheadtail = ECL + elj + epol
1287 ELSE IF ((isel.eq.2.and.
1288 & iabs(Qi).eq.1).and.
1289 & nstate(itypi,itypj).eq.1) THEN
1290 c! Same charge-charge interaction ( +/+ or -/- )
1291 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
1292 eheadtail = ECL + Egb + Epol + Fisocav + Elj
1294 ELSE IF ((isel.eq.2.and.
1295 & iabs(Qi).eq.1).and.
1296 & nstate(itypi,itypj).ne.1) THEN
1297 c! Different charge-charge interaction ( +/- or -/+ )
1299 & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1301 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
1302 c! write (*,*) "evdw = ", evdw
1303 c! write (*,*) "Fcav = ", Fcav
1304 c! write (*,*) "eheadtail = ", eheadtail
1308 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,9f16.7)')
1309 & restyp(itype(i)),i,restyp(itype(j)),j,
1310 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1312 IF (energy_dec) write (*,'(2(1x,a3,i3),3f6.2,9f16.7)')
1313 & restyp(itype(i)),i,restyp(itype(j)),j,
1314 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1321 c!-------------------------------------------------------------------
1322 c! As all angular derivatives are done, now we sum them up,
1323 c! then transform and project into cartesian vectors and add to gvdwc
1324 c! We call sc_grad always, with the exception of +/- interaction.
1325 c! This is because energy_quad subroutine needs to handle
1326 c! this job in his own way.
1327 c! This IS probably not very efficient and SHOULD be optimised
1328 c! but it will require major restructurization of emomo
1329 c! so it will be left as it is for now
1330 c! write (*,*) 'troll1, nstate =', nstate (itypi,itypj)
1331 IF (nstate(itypi,itypj).eq.1) THEN
1333 IF (bb(itypi,itypj).gt.0) THEN
1342 c!-------------------------------------------------------------------
1347 c write (iout,*) "Number of loop steps in EGB:",ind
1348 c energy_dec=.false.
1350 END SUBROUTINE emomo
1354 C-----------------------------------------------------------------------------
1357 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
1359 INCLUDE 'DIMENSIONS'
1360 INCLUDE 'sizesclu.dat'
1361 INCLUDE 'COMMON.CALC'
1362 INCLUDE 'COMMON.CHAIN'
1363 INCLUDE 'COMMON.CONTROL'
1364 INCLUDE 'COMMON.DERIV'
1365 INCLUDE 'COMMON.EMP'
1366 INCLUDE 'COMMON.GEO'
1367 INCLUDE 'COMMON.INTERACT'
1368 INCLUDE 'COMMON.IOUNITS'
1369 INCLUDE 'COMMON.LOCAL'
1370 INCLUDE 'COMMON.NAMES'
1371 INCLUDE 'COMMON.VAR'
1372 double precision scalar, facd3, facd4, federmaus, adler
1373 c! Epol and Gpol analytical parameters
1374 alphapol1 = alphapol(itypi,itypj)
1375 alphapol2 = alphapol(itypj,itypi)
1376 c! Fisocav and Gisocav analytical parameters
1377 al1 = alphiso(1,itypi,itypj)
1378 al2 = alphiso(2,itypi,itypj)
1379 al3 = alphiso(3,itypi,itypj)
1380 al4 = alphiso(4,itypi,itypj)
1382 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1383 & + sigiso2(itypi,itypj)**2.0d0))
1385 pis = sig0head(itypi,itypj)
1386 eps_head = epshead(itypi,itypj)
1387 Rhead_sq = Rhead * Rhead
1388 c! R1 - distance between head of ith side chain and tail of jth sidechain
1389 c! R2 - distance between head of jth side chain and tail of ith sidechain
1393 c! Calculate head-to-tail distances needed by Epol
1394 R1=R1+(ctail(k,2)-chead(k,1))**2
1395 R2=R2+(chead(k,2)-ctail(k,1))**2
1401 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1402 c! & +dhead(1,1,itypi,itypj))**2))
1403 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1404 c! & +dhead(2,1,itypi,itypj))**2))
1406 c!-------------------------------------------------------------------
1407 c! Coulomb electrostatic interaction
1408 Ecl = (332.0d0 * Qij) / Rhead
1409 c! derivative of Ecl is Gcl...
1410 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
1414 c!-------------------------------------------------------------------
1415 c! Generalised Born Solvent Polarization
1416 c! Charged head polarizes the solvent
1417 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1418 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1419 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1420 c! Derivative of Egb is Ggb...
1421 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1422 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1424 dGGBdR = dGGBdFGB * dFGBdR
1425 c!-------------------------------------------------------------------
1426 c! Fisocav - isotropic cavity creation term
1427 c! or "how much energy it costs to put charged head in water"
1429 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1430 bot = (1.0d0 + al4 * pom**12.0d0)
1433 c! write (*,*) "Rhead = ",Rhead
1434 c! write (*,*) "csig = ",csig
1435 c! write (*,*) "pom = ",pom
1436 c! write (*,*) "al1 = ",al1
1437 c! write (*,*) "al2 = ",al2
1438 c! write (*,*) "al3 = ",al3
1439 c! write (*,*) "al4 = ",al4
1440 c! write (*,*) "top = ",top
1441 c! write (*,*) "bot = ",bot
1442 c! Derivative of Fisocav is GCV...
1443 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1444 dbot = 12.0d0 * al4 * pom ** 11.0d0
1445 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1446 c!-------------------------------------------------------------------
1448 c! Polarization energy - charged heads polarize hydrophobic "neck"
1449 MomoFac1 = (1.0d0 - chi1 * sqom2)
1450 MomoFac2 = (1.0d0 - chi2 * sqom1)
1451 RR1 = ( R1 * R1 ) / MomoFac1
1452 RR2 = ( R2 * R2 ) / MomoFac2
1453 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1454 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1455 fgb1 = sqrt( RR1 + a12sq * ee1 )
1456 fgb2 = sqrt( RR2 + a12sq * ee2 )
1457 epol = 332.0d0 * eps_inout_fac * (
1458 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1460 c write (*,*) "eps_inout_fac = ",eps_inout_fac
1461 c write (*,*) "alphapol1 = ", alphapol1
1462 c write (*,*) "alphapol2 = ", alphapol2
1463 c write (*,*) "fgb1 = ", fgb1
1464 c write (*,*) "fgb2 = ", fgb2
1465 c write (*,*) "epol = ", epol
1466 c! derivative of Epol is Gpol...
1467 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1469 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1471 dFGBdR1 = ( (R1 / MomoFac1)
1472 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1473 & / ( 2.0d0 * fgb1 )
1474 dFGBdR2 = ( (R2 / MomoFac2)
1475 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1476 & / ( 2.0d0 * fgb2 )
1477 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1478 & * ( 2.0d0 - 0.5d0 * ee1) )
1479 & / ( 2.0d0 * fgb1 )
1480 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1481 & * ( 2.0d0 - 0.5d0 * ee2) )
1482 & / ( 2.0d0 * fgb2 )
1483 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1485 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1487 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1489 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1491 c!-------------------------------------------------------------------
1493 c! Lennard-Jones 6-12 interaction between heads
1494 pom = (pis / Rhead)**6.0d0
1495 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1496 c! derivative of Elj is Glj
1497 dGLJdR = 4.0d0 * eps_head
1498 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1499 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1500 c!-------------------------------------------------------------------
1501 c! Return the results
1502 c! These things do the dRdX derivatives, that is
1503 c! allow us to change what we see from function that changes with
1504 c! distance to function that changes with LOCATION (of the interaction
1507 erhead(k) = Rhead_distance(k)/Rhead
1508 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1509 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1512 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1513 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1514 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1515 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1516 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1517 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1518 facd1 = d1 * vbld_inv(i+nres)
1519 facd2 = d2 * vbld_inv(j+nres)
1520 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1521 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1523 c! Now we add appropriate partial derivatives (one in each dimension)
1525 hawk = (erhead_tail(k,1) +
1526 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
1527 condor = (erhead_tail(k,2) +
1528 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
1530 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1531 gvdwx(k,i) = gvdwx(k,i)
1536 & - dPOLdR2 * (erhead_tail(k,2)
1537 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1540 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1541 gvdwx(k,j) = gvdwx(k,j)
1545 & + dPOLdR1 * (erhead_tail(k,1)
1546 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1547 & + dPOLdR2 * condor
1550 gvdwc(k,i) = gvdwc(k,i)
1551 & - dGCLdR * erhead(k)
1552 & - dGGBdR * erhead(k)
1553 & - dGCVdR * erhead(k)
1554 & - dPOLdR1 * erhead_tail(k,1)
1555 & - dPOLdR2 * erhead_tail(k,2)
1556 & - dGLJdR * erhead(k)
1558 gvdwc(k,j) = gvdwc(k,j)
1559 & + dGCLdR * erhead(k)
1560 & + dGGBdR * erhead(k)
1561 & + dGCVdR * erhead(k)
1562 & + dPOLdR1 * erhead_tail(k,1)
1563 & + dPOLdR2 * erhead_tail(k,2)
1564 & + dGLJdR * erhead(k)
1569 c!-------------------------------------------------------------------
1570 SUBROUTINE energy_quad
1571 &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1573 INCLUDE 'DIMENSIONS'
1574 INCLUDE 'sizesclu.dat'
1575 INCLUDE 'COMMON.CALC'
1576 INCLUDE 'COMMON.CHAIN'
1577 INCLUDE 'COMMON.CONTROL'
1578 INCLUDE 'COMMON.DERIV'
1579 INCLUDE 'COMMON.EMP'
1580 INCLUDE 'COMMON.GEO'
1581 INCLUDE 'COMMON.INTERACT'
1582 INCLUDE 'COMMON.IOUNITS'
1583 INCLUDE 'COMMON.LOCAL'
1584 INCLUDE 'COMMON.NAMES'
1585 INCLUDE 'COMMON.VAR'
1586 double precision scalar
1587 double precision ener(4)
1588 double precision dcosom1(3),dcosom2(3)
1589 c! used in Epol derivatives
1590 double precision facd3, facd4
1591 double precision federmaus, adler
1592 c! Epol and Gpol analytical parameters
1593 alphapol1 = alphapol(itypi,itypj)
1594 alphapol2 = alphapol(itypj,itypi)
1595 c! Fisocav and Gisocav analytical parameters
1596 al1 = alphiso(1,itypi,itypj)
1597 al2 = alphiso(2,itypi,itypj)
1598 al3 = alphiso(3,itypi,itypj)
1599 al4 = alphiso(4,itypi,itypj)
1601 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1602 & + sigiso2(itypi,itypj)**2.0d0))
1604 w1 = wqdip(1,itypi,itypj)
1605 w2 = wqdip(2,itypi,itypj)
1606 pis = sig0head(itypi,itypj)
1607 eps_head = epshead(itypi,itypj)
1608 c! First things first:
1609 c! We need to do sc_grad's job with GB and Fcav
1611 & eps2der * eps2rt_om1
1612 & - 2.0D0 * alf1 * eps3der
1613 & + sigder * sigsq_om1
1616 & eps2der * eps2rt_om2
1617 & + 2.0D0 * alf2 * eps3der
1618 & + sigder * sigsq_om2
1621 & evdwij * eps1_om12
1622 & + eps2der * eps2rt_om12
1623 & - 2.0D0 * alf12 * eps3der
1624 & + sigder *sigsq_om12
1626 c! now some magical transformations to project gradient into
1627 c! three cartesian vectors
1629 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1630 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1631 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
1632 c! this acts on hydrophobic center of interaction
1633 gvdwx(k,i)= gvdwx(k,i) - gg(k)
1634 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1635 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1636 gvdwx(k,j)= gvdwx(k,j) + gg(k)
1637 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1638 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1639 c! this acts on Calpha
1640 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1641 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1643 c! sc_grad is done, now we will compute
1652 c! d1 = dhead(1, 1, itypi, itypj)
1653 c! d2 = dhead(2, 1, itypi, itypj)
1654 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1655 c! & +dhead(1,ii,itypi,itypj))**2))
1656 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1657 c! & +dhead(2,jj,itypi,itypj))**2))
1658 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1659 c! END OF ENERGY DEBUG
1660 c*************************************************************
1661 DO istate = 1, nstate(itypi,itypj)
1662 c*************************************************************
1663 IF (istate.ne.1) THEN
1664 IF (istate.lt.3) THEN
1670 d1 = dhead(1,ii,itypi,itypj)
1671 d2 = dhead(2,jj,itypi,itypj)
1673 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
1674 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
1675 Rhead_distance(k) = chead(k,2) - chead(k,1)
1677 c! pitagoras (root of sum of squares)
1679 & (Rhead_distance(1)*Rhead_distance(1))
1680 & + (Rhead_distance(2)*Rhead_distance(2))
1681 & + (Rhead_distance(3)*Rhead_distance(3)))
1683 Rhead_sq = Rhead * Rhead
1685 c! R1 - distance between head of ith side chain and tail of jth sidechain
1686 c! R2 - distance between head of jth side chain and tail of ith sidechain
1690 c! Calculate head-to-tail distances
1691 R1=R1+(ctail(k,2)-chead(k,1))**2
1692 R2=R2+(chead(k,2)-ctail(k,1))**2
1699 c! write (*,*) "istate = ", istate
1700 c! write (*,*) "ii = ", ii
1701 c! write (*,*) "jj = ", jj
1702 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1703 c! & +dhead(1,ii,itypi,itypj))**2))
1704 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1705 c! & +dhead(2,jj,itypi,itypj))**2))
1706 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1707 c! Rhead_sq = Rhead * Rhead
1708 c! write (*,*) "d1 = ",d1
1709 c! write (*,*) "d2 = ",d2
1710 c! write (*,*) "R1 = ",R1
1711 c! write (*,*) "R2 = ",R2
1712 c! write (*,*) "Rhead = ",Rhead
1713 c! END OF ENERGY DEBUG
1715 c!-------------------------------------------------------------------
1716 c! Coulomb electrostatic interaction
1717 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
1719 c! write (*,*) "Ecl = ", Ecl
1720 c! derivative of Ecl is Gcl...
1721 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
1726 c!-------------------------------------------------------------------
1727 c! Generalised Born Solvent Polarization
1728 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1729 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1730 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1732 c! write (*,*) "a1*a2 = ", a12sq
1733 c! write (*,*) "Rhead = ", Rhead
1734 c! write (*,*) "Rhead_sq = ", Rhead_sq
1735 c! write (*,*) "ee = ", ee
1736 c! write (*,*) "Fgb = ", Fgb
1737 c! write (*,*) "fac = ", eps_inout_fac
1738 c! write (*,*) "Qij = ", Qij
1739 c! write (*,*) "Egb = ", Egb
1740 c! Derivative of Egb is Ggb...
1741 c! dFGBdR is used by Quad's later...
1742 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1743 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1745 dGGBdR = dGGBdFGB * dFGBdR
1747 c!-------------------------------------------------------------------
1748 c! Fisocav - isotropic cavity creation term
1750 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1751 bot = (1.0d0 + al4 * pom**12.0d0)
1755 c! write (*,*) "pom = ",pom
1756 c! write (*,*) "al1 = ",al1
1757 c! write (*,*) "al2 = ",al2
1758 c! write (*,*) "al3 = ",al3
1759 c! write (*,*) "al4 = ",al4
1760 c! write (*,*) "top = ",top
1761 c! write (*,*) "bot = ",bot
1762 c! write (*,*) "Fisocav = ", Fisocav
1764 c! Derivative of Fisocav is GCV...
1765 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1766 dbot = 12.0d0 * al4 * pom ** 11.0d0
1767 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1769 c!-------------------------------------------------------------------
1770 c! Polarization energy
1772 MomoFac1 = (1.0d0 - chi1 * sqom2)
1773 MomoFac2 = (1.0d0 - chi2 * sqom1)
1774 RR1 = ( R1 * R1 ) / MomoFac1
1775 RR2 = ( R2 * R2 ) / MomoFac2
1776 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1777 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1778 fgb1 = sqrt( RR1 + a12sq * ee1 )
1779 fgb2 = sqrt( RR2 + a12sq * ee2 )
1780 epol = 332.0d0 * eps_inout_fac * (
1781 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1783 c! derivative of Epol is Gpol...
1784 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1786 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1788 dFGBdR1 = ( (R1 / MomoFac1)
1789 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1790 & / ( 2.0d0 * fgb1 )
1791 dFGBdR2 = ( (R2 / MomoFac2)
1792 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1793 & / ( 2.0d0 * fgb2 )
1794 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1795 & * ( 2.0d0 - 0.5d0 * ee1) )
1796 & / ( 2.0d0 * fgb1 )
1797 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1798 & * ( 2.0d0 - 0.5d0 * ee2) )
1799 & / ( 2.0d0 * fgb2 )
1800 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1802 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1804 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1806 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1808 c!-------------------------------------------------------------------
1810 pom = (pis / Rhead)**6.0d0
1811 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1813 c! derivative of Elj is Glj
1814 dGLJdR = 4.0d0 * eps_head
1815 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1816 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1818 c!-------------------------------------------------------------------
1820 IF (Wqd.ne.0.0d0) THEN
1821 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0)
1822 & - 37.5d0 * ( sqom1 + sqom2 )
1823 & + 157.5d0 * ( sqom1 * sqom2 )
1824 & - 45.0d0 * om1*om2*om12
1825 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
1828 c! derivative of Equad...
1829 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
1832 & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
1833 c! dQUADdOM1 = 0.0d0
1835 & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
1836 c! dQUADdOM2 = 0.0d0
1838 & * ( 6.0d0*om12 - 45.0d0*om1*om2 )
1839 c! dQUADdOM12 = 0.0d0
1844 c!-------------------------------------------------------------------
1845 c! Return the results
1847 eom1 = dPOLdOM1 + dQUADdOM1
1848 eom2 = dPOLdOM2 + dQUADdOM2
1850 c! now some magical transformations to project gradient into
1851 c! three cartesian vectors
1853 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1854 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1855 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
1859 erhead(k) = Rhead_distance(k)/Rhead
1860 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1861 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1863 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1864 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1865 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1866 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1867 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1868 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1869 facd1 = d1 * vbld_inv(i+nres)
1870 facd2 = d2 * vbld_inv(j+nres)
1871 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1872 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1873 c! Throw the results into gheadtail which holds gradients
1874 c! for each micro-state
1876 hawk = erhead_tail(k,1) +
1877 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
1878 condor = erhead_tail(k,2) +
1879 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
1881 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1882 c! this acts on hydrophobic center of interaction
1883 gheadtail(k,1,1) = gheadtail(k,1,1)
1888 & - dPOLdR2 * (erhead_tail(k,2)
1889 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1893 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1894 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1896 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1897 c! this acts on hydrophobic center of interaction
1898 gheadtail(k,2,1) = gheadtail(k,2,1)
1902 & + dPOLdR1 * (erhead_tail(k,1)
1903 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1904 & + dPOLdR2 * condor
1908 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1909 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1911 c! this acts on Calpha
1912 gheadtail(k,3,1) = gheadtail(k,3,1)
1913 & - dGCLdR * erhead(k)
1914 & - dGGBdR * erhead(k)
1915 & - dGCVdR * erhead(k)
1916 & - dPOLdR1 * erhead_tail(k,1)
1917 & - dPOLdR2 * erhead_tail(k,2)
1918 & - dGLJdR * erhead(k)
1919 & - dQUADdR * erhead(k)
1922 c! this acts on Calpha
1923 gheadtail(k,4,1) = gheadtail(k,4,1)
1924 & + dGCLdR * erhead(k)
1925 & + dGGBdR * erhead(k)
1926 & + dGCVdR * erhead(k)
1927 & + dPOLdR1 * erhead_tail(k,1)
1928 & + dPOLdR2 * erhead_tail(k,2)
1929 & + dGLJdR * erhead(k)
1930 & + dQUADdR * erhead(k)
1933 c! write(*,*) "ECL = ", Ecl
1934 c! write(*,*) "Egb = ", Egb
1935 c! write(*,*) "Epol = ", Epol
1936 c! write(*,*) "Fisocav = ", Fisocav
1937 c! write(*,*) "Elj = ", Elj
1938 c! write(*,*) "Equad = ", Equad
1939 c! write(*,*) "wstate = ", wstate(istate,itypi,itypj)
1940 c! write(*,*) "eheadtail = ", eheadtail
1941 c! write(*,*) "TROLL = ", dexp(-betaTT * ener(istate))
1942 c! write(*,*) "dGCLdR = ", dGCLdR
1943 c! write(*,*) "dGGBdR = ", dGGBdR
1944 c! write(*,*) "dGCVdR = ", dGCVdR
1945 c! write(*,*) "dPOLdR1 = ", dPOLdR1
1946 c! write(*,*) "dPOLdR2 = ", dPOLdR2
1947 c! write(*,*) "dGLJdR = ", dGLJdR
1948 c! write(*,*) "dQUADdR = ", dQUADdR
1949 c! write(*,*) "tuna(",k,") = ", tuna(k)
1950 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
1951 eheadtail = eheadtail
1952 & + wstate(istate, itypi, itypj)
1953 & * dexp(-betaTT * ener(istate))
1954 c! foreach cartesian dimension
1956 c! foreach of two gvdwx and gvdwc
1958 gheadtail(k,l,2) = gheadtail(k,l,2)
1959 & + wstate( istate, itypi, itypj )
1960 & * dexp(-betaTT * ener(istate))
1961 & * gheadtail(k,l,1)
1962 gheadtail(k,l,1) = 0.0d0
1966 c! Here ended the gigantic DO istate = 1, 4, which starts
1967 c! at the beggining of the subroutine
1971 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
1973 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
1974 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
1975 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
1976 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
1978 gheadtail(k,l,1) = 0.0d0
1979 gheadtail(k,l,2) = 0.0d0
1982 eheadtail = (-dlog(eheadtail)) / betaTT
1989 END SUBROUTINE energy_quad
1992 c!-------------------------------------------------------------------
1995 SUBROUTINE eqn(Epol)
1997 INCLUDE 'DIMENSIONS'
1998 INCLUDE 'sizesclu.dat'
1999 INCLUDE 'COMMON.CALC'
2000 INCLUDE 'COMMON.CHAIN'
2001 INCLUDE 'COMMON.CONTROL'
2002 INCLUDE 'COMMON.DERIV'
2003 INCLUDE 'COMMON.EMP'
2004 INCLUDE 'COMMON.GEO'
2005 INCLUDE 'COMMON.INTERACT'
2006 INCLUDE 'COMMON.IOUNITS'
2007 INCLUDE 'COMMON.LOCAL'
2008 INCLUDE 'COMMON.NAMES'
2009 INCLUDE 'COMMON.VAR'
2010 double precision scalar, facd4, federmaus
2011 alphapol1 = alphapol(itypi,itypj)
2012 c! R1 - distance between head of ith side chain and tail of jth sidechain
2015 c! Calculate head-to-tail distances
2016 R1=R1+(ctail(k,2)-chead(k,1))**2
2021 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2022 c! & +dhead(1,1,itypi,itypj))**2))
2023 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2024 c! & +dhead(2,1,itypi,itypj))**2))
2025 c--------------------------------------------------------------------
2026 c Polarization energy
2028 MomoFac1 = (1.0d0 - chi1 * sqom2)
2029 RR1 = R1 * R1 / MomoFac1
2030 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2031 fgb1 = sqrt( RR1 + a12sq * ee1)
2032 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2034 c!------------------------------------------------------------------
2035 c! derivative of Epol is Gpol...
2036 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2038 dFGBdR1 = ( (R1 / MomoFac1)
2039 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2040 & / ( 2.0d0 * fgb1 )
2041 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2042 & * (2.0d0 - 0.5d0 * ee1) )
2044 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2047 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2049 c!-------------------------------------------------------------------
2050 c! Return the results
2051 c! (see comments in Eqq)
2053 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2055 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2056 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2057 facd1 = d1 * vbld_inv(i+nres)
2058 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2061 hawk = (erhead_tail(k,1) +
2062 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2064 gvdwx(k,i) = gvdwx(k,i)
2066 gvdwx(k,j) = gvdwx(k,j)
2067 & + dPOLdR1 * (erhead_tail(k,1)
2068 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2070 gvdwc(k,i) = gvdwc(k,i)
2071 & - dPOLdR1 * erhead_tail(k,1)
2072 gvdwc(k,j) = gvdwc(k,j)
2073 & + dPOLdR1 * erhead_tail(k,1)
2080 c!-------------------------------------------------------------------
2084 SUBROUTINE enq(Epol)
2086 INCLUDE 'DIMENSIONS'
2087 INCLUDE 'sizesclu.dat'
2088 INCLUDE 'COMMON.CALC'
2089 INCLUDE 'COMMON.CHAIN'
2090 INCLUDE 'COMMON.CONTROL'
2091 INCLUDE 'COMMON.DERIV'
2092 INCLUDE 'COMMON.EMP'
2093 INCLUDE 'COMMON.GEO'
2094 INCLUDE 'COMMON.INTERACT'
2095 INCLUDE 'COMMON.IOUNITS'
2096 INCLUDE 'COMMON.LOCAL'
2097 INCLUDE 'COMMON.NAMES'
2098 INCLUDE 'COMMON.VAR'
2099 double precision scalar, facd3, adler
2100 alphapol2 = alphapol(itypj,itypi)
2101 c! R2 - distance between head of jth side chain and tail of ith sidechain
2104 c! Calculate head-to-tail distances
2105 R2=R2+(chead(k,2)-ctail(k,1))**2
2110 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2111 c! & +dhead(1,1,itypi,itypj))**2))
2112 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2113 c! & +dhead(2,1,itypi,itypj))**2))
2114 c------------------------------------------------------------------------
2115 c Polarization energy
2116 MomoFac2 = (1.0d0 - chi2 * sqom1)
2117 RR2 = R2 * R2 / MomoFac2
2118 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2119 fgb2 = sqrt(RR2 + a12sq * ee2)
2120 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2122 c!-------------------------------------------------------------------
2123 c! derivative of Epol is Gpol...
2124 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2126 dFGBdR2 = ( (R2 / MomoFac2)
2127 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2129 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2130 & * (2.0d0 - 0.5d0 * ee2) )
2132 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2134 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2137 c!-------------------------------------------------------------------
2138 c! Return the results
2139 c! (See comments in Eqq)
2141 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2143 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2144 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2145 facd2 = d2 * vbld_inv(j+nres)
2146 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2148 condor = (erhead_tail(k,2)
2149 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2151 gvdwx(k,i) = gvdwx(k,i)
2152 & - dPOLdR2 * (erhead_tail(k,2)
2153 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2154 gvdwx(k,j) = gvdwx(k,j)
2155 & + dPOLdR2 * condor
2157 gvdwc(k,i) = gvdwc(k,i)
2158 & - dPOLdR2 * erhead_tail(k,2)
2159 gvdwc(k,j) = gvdwc(k,j)
2160 & + dPOLdR2 * erhead_tail(k,2)
2167 c!-------------------------------------------------------------------
2170 SUBROUTINE eqd(Ecl,Elj,Epol)
2172 INCLUDE 'DIMENSIONS'
2173 INCLUDE 'sizesclu.dat'
2174 INCLUDE 'COMMON.CALC'
2175 INCLUDE 'COMMON.CHAIN'
2176 INCLUDE 'COMMON.CONTROL'
2177 INCLUDE 'COMMON.DERIV'
2178 INCLUDE 'COMMON.EMP'
2179 INCLUDE 'COMMON.GEO'
2180 INCLUDE 'COMMON.INTERACT'
2181 INCLUDE 'COMMON.IOUNITS'
2182 INCLUDE 'COMMON.LOCAL'
2183 INCLUDE 'COMMON.NAMES'
2184 INCLUDE 'COMMON.VAR'
2185 double precision scalar, facd4, federmaus
2186 alphapol1 = alphapol(itypi,itypj)
2187 w1 = wqdip(1,itypi,itypj)
2188 w2 = wqdip(2,itypi,itypj)
2189 pis = sig0head(itypi,itypj)
2190 eps_head = epshead(itypi,itypj)
2191 c!-------------------------------------------------------------------
2192 c! R1 - distance between head of ith side chain and tail of jth sidechain
2195 c! Calculate head-to-tail distances
2196 R1=R1+(ctail(k,2)-chead(k,1))**2
2201 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2202 c! & +dhead(1,1,itypi,itypj))**2))
2203 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2204 c! & +dhead(2,1,itypi,itypj))**2))
2206 c!-------------------------------------------------------------------
2208 sparrow = w1 * Qi * om1
2209 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2210 Ecl = sparrow / Rhead**2.0d0
2211 & - hawk / Rhead**4.0d0
2212 c!-------------------------------------------------------------------
2213 c! derivative of ecl is Gcl
2215 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2216 & + 4.0d0 * hawk / Rhead**5.0d0
2218 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2220 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2221 c--------------------------------------------------------------------
2222 c Polarization energy
2224 MomoFac1 = (1.0d0 - chi1 * sqom2)
2225 RR1 = R1 * R1 / MomoFac1
2226 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2227 fgb1 = sqrt( RR1 + a12sq * ee1)
2228 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2230 c!------------------------------------------------------------------
2231 c! derivative of Epol is Gpol...
2232 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2234 dFGBdR1 = ( (R1 / MomoFac1)
2235 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2236 & / ( 2.0d0 * fgb1 )
2237 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2238 & * (2.0d0 - 0.5d0 * ee1) )
2240 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2243 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2245 c!-------------------------------------------------------------------
2247 pom = (pis / Rhead)**6.0d0
2248 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2249 c! derivative of Elj is Glj
2250 dGLJdR = 4.0d0 * eps_head
2251 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2252 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2253 c!-------------------------------------------------------------------
2254 c! Return the results
2256 erhead(k) = Rhead_distance(k)/Rhead
2257 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2260 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2261 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2262 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2263 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2264 facd1 = d1 * vbld_inv(i+nres)
2265 facd2 = d2 * vbld_inv(j+nres)
2266 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2269 hawk = (erhead_tail(k,1) +
2270 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2272 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2273 gvdwx(k,i) = gvdwx(k,i)
2278 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2279 gvdwx(k,j) = gvdwx(k,j)
2281 & + dPOLdR1 * (erhead_tail(k,1)
2282 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2286 gvdwc(k,i) = gvdwc(k,i)
2287 & - dGCLdR * erhead(k)
2288 & - dPOLdR1 * erhead_tail(k,1)
2289 & - dGLJdR * erhead(k)
2291 gvdwc(k,j) = gvdwc(k,j)
2292 & + dGCLdR * erhead(k)
2293 & + dPOLdR1 * erhead_tail(k,1)
2294 & + dGLJdR * erhead(k)
2301 c!-------------------------------------------------------------------
2304 SUBROUTINE edq(Ecl,Elj,Epol)
2306 INCLUDE 'DIMENSIONS'
2307 INCLUDE 'sizesclu.dat'
2308 INCLUDE 'COMMON.CALC'
2309 INCLUDE 'COMMON.CHAIN'
2310 INCLUDE 'COMMON.CONTROL'
2311 INCLUDE 'COMMON.DERIV'
2312 INCLUDE 'COMMON.EMP'
2313 INCLUDE 'COMMON.GEO'
2314 INCLUDE 'COMMON.INTERACT'
2315 INCLUDE 'COMMON.IOUNITS'
2316 INCLUDE 'COMMON.LOCAL'
2317 INCLUDE 'COMMON.NAMES'
2318 INCLUDE 'COMMON.VAR'
2319 double precision scalar, facd3, adler
2320 alphapol2 = alphapol(itypj,itypi)
2321 w1 = wqdip(1,itypi,itypj)
2322 w2 = wqdip(2,itypi,itypj)
2323 pis = sig0head(itypi,itypj)
2324 eps_head = epshead(itypi,itypj)
2325 c!-------------------------------------------------------------------
2326 c! R2 - distance between head of jth side chain and tail of ith sidechain
2329 c! Calculate head-to-tail distances
2330 R2=R2+(chead(k,2)-ctail(k,1))**2
2335 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2336 c! & +dhead(1,1,itypi,itypj))**2))
2337 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2338 c! & +dhead(2,1,itypi,itypj))**2))
2341 c!-------------------------------------------------------------------
2343 sparrow = w1 * Qi * om1
2344 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2345 ECL = sparrow / Rhead**2.0d0
2346 & - hawk / Rhead**4.0d0
2347 c!-------------------------------------------------------------------
2348 c! derivative of ecl is Gcl
2350 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2351 & + 4.0d0 * hawk / Rhead**5.0d0
2353 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2355 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2356 c--------------------------------------------------------------------
2357 c Polarization energy
2359 MomoFac2 = (1.0d0 - chi2 * sqom1)
2360 RR2 = R2 * R2 / MomoFac2
2361 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2362 fgb2 = sqrt(RR2 + a12sq * ee2)
2363 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2365 c! derivative of Epol is Gpol...
2366 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2368 dFGBdR2 = ( (R2 / MomoFac2)
2369 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2371 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2372 & * (2.0d0 - 0.5d0 * ee2) )
2374 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2376 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2379 c!-------------------------------------------------------------------
2381 pom = (pis / Rhead)**6.0d0
2382 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2383 c! derivative of Elj is Glj
2384 dGLJdR = 4.0d0 * eps_head
2385 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2386 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2387 c!-------------------------------------------------------------------
2388 c! Return the results
2389 c! (see comments in Eqq)
2391 erhead(k) = Rhead_distance(k)/Rhead
2392 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2394 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2395 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2396 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2397 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2398 facd1 = d1 * vbld_inv(i+nres)
2399 facd2 = d2 * vbld_inv(j+nres)
2400 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2403 condor = (erhead_tail(k,2)
2404 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2406 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2407 gvdwx(k,i) = gvdwx(k,i)
2409 & - dPOLdR2 * (erhead_tail(k,2)
2410 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2413 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2414 gvdwx(k,j) = gvdwx(k,j)
2416 & + dPOLdR2 * condor
2420 gvdwc(k,i) = gvdwc(k,i)
2421 & - dGCLdR * erhead(k)
2422 & - dPOLdR2 * erhead_tail(k,2)
2423 & - dGLJdR * erhead(k)
2425 gvdwc(k,j) = gvdwc(k,j)
2426 & + dGCLdR * erhead(k)
2427 & + dPOLdR2 * erhead_tail(k,2)
2428 & + dGLJdR * erhead(k)
2435 C--------------------------------------------------------------------
2440 INCLUDE 'DIMENSIONS'
2441 INCLUDE 'sizesclu.dat'
2442 INCLUDE 'COMMON.CALC'
2443 INCLUDE 'COMMON.CHAIN'
2444 INCLUDE 'COMMON.CONTROL'
2445 INCLUDE 'COMMON.DERIV'
2446 INCLUDE 'COMMON.EMP'
2447 INCLUDE 'COMMON.GEO'
2448 INCLUDE 'COMMON.INTERACT'
2449 INCLUDE 'COMMON.IOUNITS'
2450 INCLUDE 'COMMON.LOCAL'
2451 INCLUDE 'COMMON.NAMES'
2452 INCLUDE 'COMMON.VAR'
2453 double precision scalar
2454 c! csig = sigiso(itypi,itypj)
2455 w1 = wqdip(1,itypi,itypj)
2456 w2 = wqdip(2,itypi,itypj)
2457 c!-------------------------------------------------------------------
2459 fac = (om12 - 3.0d0 * om1 * om2)
2460 c1 = (w1 / (Rhead**3.0d0)) * fac
2461 c2 = (w2 / Rhead ** 6.0d0)
2462 & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2464 c! write (*,*) "w1 = ", w1
2465 c! write (*,*) "w2 = ", w2
2466 c! write (*,*) "om1 = ", om1
2467 c! write (*,*) "om2 = ", om2
2468 c! write (*,*) "om12 = ", om12
2469 c! write (*,*) "fac = ", fac
2470 c! write (*,*) "c1 = ", c1
2471 c! write (*,*) "c2 = ", c2
2472 c! write (*,*) "Ecl = ", Ecl
2473 c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
2474 c! write (*,*) "c2_2 = ",
2475 c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2476 c!-------------------------------------------------------------------
2477 c! dervative of ECL is GCL...
2479 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
2480 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0)
2481 & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
2484 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
2485 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2486 & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
2489 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
2490 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2491 & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
2494 c1 = w1 / (Rhead ** 3.0d0)
2495 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
2497 c!-------------------------------------------------------------------
2498 c! Return the results
2499 c! (see comments in Eqq)
2501 erhead(k) = Rhead_distance(k)/Rhead
2503 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2504 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2505 facd1 = d1 * vbld_inv(i+nres)
2506 facd2 = d2 * vbld_inv(j+nres)
2509 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2510 gvdwx(k,i) = gvdwx(k,i)
2512 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2513 gvdwx(k,j) = gvdwx(k,j)
2516 gvdwc(k,i) = gvdwc(k,i)
2517 & - dGCLdR * erhead(k)
2518 gvdwc(k,j) = gvdwc(k,j)
2519 & + dGCLdR * erhead(k)
2525 c!-------------------------------------------------------------------
2528 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
2531 INCLUDE 'DIMENSIONS'
2532 INCLUDE 'sizesclu.dat'
2533 c! itypi, itypj, i, j, k, l, chead,
2534 INCLUDE 'COMMON.CALC'
2536 INCLUDE 'COMMON.CHAIN'
2538 INCLUDE 'COMMON.DERIV'
2539 c! electrostatic gradients-specific variables
2540 INCLUDE 'COMMON.EMP'
2541 c! wquad, dhead, alphiso, alphasur, rborn, epsintab
2542 INCLUDE 'COMMON.INTERACT'
2543 c! io for debug, disable it in final builds
2544 INCLUDE 'COMMON.IOUNITS'
2545 c!-------------------------------------------------------------------
2548 c! what amino acid is the aminoacid j'th?
2550 c! 1/(Gas Constant * Thermostate temperature) = BetaTT
2551 c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
2552 BetaTT = 1.0d0 / (298 * 1.987d-3)
2554 sig0ij = sigma( itypi,itypj )
2555 chi1 = chi( itypi, itypj )
2556 chi2 = chi( itypj, itypi )
2558 chip1 = chipp( itypi, itypj )
2559 chip2 = chipp( itypj, itypi )
2560 chip12 = chip1 * chip2
2561 c! write (2,*) "elgrad types",itypi,itypj,
2562 c! & " chi1",chi1," chi2",chi2," chi12",chi12,
2563 c! & " chip1",chip1," chip2",chip2," chip12",chip12
2564 c! not used by momo potential, but needed by sc_angular which is shared
2565 c! by all energy_potential subroutines
2569 c! location, location, location
2570 xj = c( 1, nres+j ) - xi
2571 yj = c( 2, nres+j ) - yi
2572 zj = c( 3, nres+j ) - zi
2573 dxj = dc_norm( 1, nres+j )
2574 dyj = dc_norm( 2, nres+j )
2575 dzj = dc_norm( 3, nres+j )
2576 c! distance from center of chain(?) to polar/charged head
2577 c! write (*,*) "istate = ", 1
2578 c! write (*,*) "ii = ", 1
2579 c! write (*,*) "jj = ", 1
2580 d1 = dhead(1, 1, itypi, itypj)
2581 d2 = dhead(2, 1, itypi, itypj)
2583 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
2584 c! a12sq = a12sq * a12sq
2585 c! charge of amino acid itypi is...
2590 chis1 = chis(itypi,itypj)
2591 chis2 = chis(itypj,itypi)
2592 chis12 = chis1 * chis2
2593 sig1 = sigmap1(itypi,itypj)
2594 sig2 = sigmap2(itypi,itypj)
2595 c! write (*,*) "sig1 = ", sig1
2596 c! write (*,*) "sig2 = ", sig2
2597 c! alpha factors from Fcav/Gcav
2598 b1 = alphasur(1,itypi,itypj)
2599 b2 = alphasur(2,itypi,itypj)
2600 b3 = alphasur(3,itypi,itypj)
2601 b4 = alphasur(4,itypi,itypj)
2602 c! used to determine whether we want to do quadrupole calculations
2603 wqd = wquad(itypi, itypj)
2605 eps_in = epsintab(itypi,itypj)
2606 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
2607 c! write (*,*) "eps_inout_fac = ", eps_inout_fac
2608 c!-------------------------------------------------------------------
2609 c! tail location and distance calculations
2612 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
2613 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
2615 c! tail distances will be themselves usefull elswhere
2616 c1 (in Gcav, for example)
2617 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
2618 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
2619 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
2621 & (Rtail_distance(1)*Rtail_distance(1))
2622 & + (Rtail_distance(2)*Rtail_distance(2))
2623 & + (Rtail_distance(3)*Rtail_distance(3)))
2624 c!-------------------------------------------------------------------
2625 c! Calculate location and distance between polar heads
2626 c! distance between heads
2627 c! for each one of our three dimensional space...
2629 c! location of polar head is computed by taking hydrophobic centre
2630 c! and moving by a d1 * dc_norm vector
2631 c! see unres publications for very informative images
2632 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
2633 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
2635 c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
2636 c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
2637 Rhead_distance(k) = chead(k,2) - chead(k,1)
2639 c! pitagoras (root of sum of squares)
2641 & (Rhead_distance(1)*Rhead_distance(1))
2642 & + (Rhead_distance(2)*Rhead_distance(2))
2643 & + (Rhead_distance(3)*Rhead_distance(3)))
2644 c!-------------------------------------------------------------------
2645 c! zero everything that should be zero'ed
2658 END SUBROUTINE elgrad_init
2659 c!-------------------------------------------------------------------
2660 subroutine sc_angular
2661 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2662 C om12. Called by ebp, egb, and egbv.
2664 include 'COMMON.CALC'
2665 include 'COMMON.IOUNITS'
2669 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2670 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2671 om12=dxi*dxj+dyi*dyj+dzi*dzj
2676 C Calculate eps1(om12) and its derivative in om12
2677 faceps1=1.0D0-om12*chiom12
2678 faceps1_inv=1.0D0/faceps1
2679 eps1=dsqrt(faceps1_inv)
2680 c write (2,*) "chi1",chi1," chi2",chi2," chi12",chi12
2681 c write (2,*) "fsceps1",faceps1," faceps1_inv",faceps1_inv,
2683 C Following variable is eps1*deps1/dom12
2684 eps1_om12=faceps1_inv*chiom12
2689 c write (iout,*) "om12",om12," eps1",eps1
2690 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2695 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2696 sigsq=1.0D0-facsig*faceps1_inv
2697 c write (2,*) "om1",om1," om2",om2," om1om2",om1om2,
2698 c & " chiom1",chiom1,
2699 c & " chiom2",chiom2," facsig",facsig," sigsq",sigsq
2700 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2701 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2702 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2708 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2709 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2711 C Calculate eps2 and its derivatives in om1, om2, and om12.
2714 chipom12=chip12*om12
2715 facp=1.0D0-om12*chipom12
2717 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2718 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2719 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2720 C Following variable is the square root of eps2
2721 eps2rt=1.0D0-facp1*facp_inv
2722 C Following three variables are the derivatives of the square root of eps
2723 C in om1, om2, and om12.
2724 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2725 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2726 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2727 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2728 c! Note that THIS is 0 in emomo, so we should probably move it out of sc_angular
2729 c! Or frankly, we should restructurize the whole energy section
2730 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2731 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2732 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2733 c & " eps2rt_om12",eps2rt_om12
2734 C Calculate whole angle-dependent part of epsilon and contributions
2735 C to its derivatives
2738 C----------------------------------------------------------------------------
2739 C----------------------------------------------------------------------------
2741 implicit real*8 (a-h,o-z)
2742 include 'DIMENSIONS'
2743 include 'sizesclu.dat'
2744 include 'COMMON.CHAIN'
2745 include 'COMMON.DERIV'
2746 include 'COMMON.CALC'
2747 double precision dcosom1(3),dcosom2(3)
2748 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2749 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2750 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2751 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2753 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2754 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2757 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2760 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2761 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2762 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2763 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2764 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2765 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2768 C Calculate the components of the gradient in DC and X
2772 gvdwc(l,k)=gvdwc(l,k)+gg(l)
2777 c------------------------------------------------------------------------------
2778 subroutine vec_and_deriv
2779 implicit real*8 (a-h,o-z)
2780 include 'DIMENSIONS'
2781 include 'sizesclu.dat'
2782 include 'COMMON.IOUNITS'
2783 include 'COMMON.GEO'
2784 include 'COMMON.VAR'
2785 include 'COMMON.LOCAL'
2786 include 'COMMON.CHAIN'
2787 include 'COMMON.VECTORS'
2788 include 'COMMON.DERIV'
2789 include 'COMMON.INTERACT'
2790 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2791 C Compute the local reference systems. For reference system (i), the
2792 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2793 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2795 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
2796 if (i.eq.nres-1) then
2797 C Case of the last full residue
2798 C Compute the Z-axis
2799 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2800 costh=dcos(pi-theta(nres))
2801 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2806 C Compute the derivatives of uz
2808 uzder(2,1,1)=-dc_norm(3,i-1)
2809 uzder(3,1,1)= dc_norm(2,i-1)
2810 uzder(1,2,1)= dc_norm(3,i-1)
2812 uzder(3,2,1)=-dc_norm(1,i-1)
2813 uzder(1,3,1)=-dc_norm(2,i-1)
2814 uzder(2,3,1)= dc_norm(1,i-1)
2817 uzder(2,1,2)= dc_norm(3,i)
2818 uzder(3,1,2)=-dc_norm(2,i)
2819 uzder(1,2,2)=-dc_norm(3,i)
2821 uzder(3,2,2)= dc_norm(1,i)
2822 uzder(1,3,2)= dc_norm(2,i)
2823 uzder(2,3,2)=-dc_norm(1,i)
2826 C Compute the Y-axis
2829 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2832 C Compute the derivatives of uy
2835 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2836 & -dc_norm(k,i)*dc_norm(j,i-1)
2837 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2839 uyder(j,j,1)=uyder(j,j,1)-costh
2840 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2845 uygrad(l,k,j,i)=uyder(l,k,j)
2846 uzgrad(l,k,j,i)=uzder(l,k,j)
2850 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2851 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2852 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2853 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2857 C Compute the Z-axis
2858 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2859 costh=dcos(pi-theta(i+2))
2860 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2865 C Compute the derivatives of uz
2867 uzder(2,1,1)=-dc_norm(3,i+1)
2868 uzder(3,1,1)= dc_norm(2,i+1)
2869 uzder(1,2,1)= dc_norm(3,i+1)
2871 uzder(3,2,1)=-dc_norm(1,i+1)
2872 uzder(1,3,1)=-dc_norm(2,i+1)
2873 uzder(2,3,1)= dc_norm(1,i+1)
2876 uzder(2,1,2)= dc_norm(3,i)
2877 uzder(3,1,2)=-dc_norm(2,i)
2878 uzder(1,2,2)=-dc_norm(3,i)
2880 uzder(3,2,2)= dc_norm(1,i)
2881 uzder(1,3,2)= dc_norm(2,i)
2882 uzder(2,3,2)=-dc_norm(1,i)
2885 C Compute the Y-axis
2888 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2891 C Compute the derivatives of uy
2894 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2895 & -dc_norm(k,i)*dc_norm(j,i+1)
2896 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2898 uyder(j,j,1)=uyder(j,j,1)-costh
2899 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2904 uygrad(l,k,j,i)=uyder(l,k,j)
2905 uzgrad(l,k,j,i)=uzder(l,k,j)
2909 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2910 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2911 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2912 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2918 vbld_inv_temp(1)=vbld_inv(i+1)
2919 if (i.lt.nres-1) then
2920 vbld_inv_temp(2)=vbld_inv(i+2)
2922 vbld_inv_temp(2)=vbld_inv(i)
2927 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2928 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2936 C-----------------------------------------------------------------------------
2937 subroutine vec_and_deriv_test
2938 implicit real*8 (a-h,o-z)
2939 include 'DIMENSIONS'
2940 include 'sizesclu.dat'
2941 include 'COMMON.IOUNITS'
2942 include 'COMMON.GEO'
2943 include 'COMMON.VAR'
2944 include 'COMMON.LOCAL'
2945 include 'COMMON.CHAIN'
2946 include 'COMMON.VECTORS'
2947 dimension uyder(3,3,2),uzder(3,3,2)
2948 C Compute the local reference systems. For reference system (i), the
2949 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2950 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2952 if (i.eq.nres-1) then
2953 C Case of the last full residue
2954 C Compute the Z-axis
2955 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2956 costh=dcos(pi-theta(nres))
2957 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2958 c write (iout,*) 'fac',fac,
2959 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
2960 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
2964 C Compute the derivatives of uz
2966 uzder(2,1,1)=-dc_norm(3,i-1)
2967 uzder(3,1,1)= dc_norm(2,i-1)
2968 uzder(1,2,1)= dc_norm(3,i-1)
2970 uzder(3,2,1)=-dc_norm(1,i-1)
2971 uzder(1,3,1)=-dc_norm(2,i-1)
2972 uzder(2,3,1)= dc_norm(1,i-1)
2975 uzder(2,1,2)= dc_norm(3,i)
2976 uzder(3,1,2)=-dc_norm(2,i)
2977 uzder(1,2,2)=-dc_norm(3,i)
2979 uzder(3,2,2)= dc_norm(1,i)
2980 uzder(1,3,2)= dc_norm(2,i)
2981 uzder(2,3,2)=-dc_norm(1,i)
2983 C Compute the Y-axis
2985 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2988 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
2989 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
2990 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
2992 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2995 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
2996 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
2999 c write (iout,*) 'facy',facy,
3000 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3001 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3003 uy(k,i)=facy*uy(k,i)
3005 C Compute the derivatives of uy
3008 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
3009 & -dc_norm(k,i)*dc_norm(j,i-1)
3010 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3012 c uyder(j,j,1)=uyder(j,j,1)-costh
3013 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
3014 uyder(j,j,1)=uyder(j,j,1)
3015 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
3016 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
3022 uygrad(l,k,j,i)=uyder(l,k,j)
3023 uzgrad(l,k,j,i)=uzder(l,k,j)
3027 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3028 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3029 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3030 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3033 C Compute the Z-axis
3034 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
3035 costh=dcos(pi-theta(i+2))
3036 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3037 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
3041 C Compute the derivatives of uz
3043 uzder(2,1,1)=-dc_norm(3,i+1)
3044 uzder(3,1,1)= dc_norm(2,i+1)
3045 uzder(1,2,1)= dc_norm(3,i+1)
3047 uzder(3,2,1)=-dc_norm(1,i+1)
3048 uzder(1,3,1)=-dc_norm(2,i+1)
3049 uzder(2,3,1)= dc_norm(1,i+1)
3052 uzder(2,1,2)= dc_norm(3,i)
3053 uzder(3,1,2)=-dc_norm(2,i)
3054 uzder(1,2,2)=-dc_norm(3,i)
3056 uzder(3,2,2)= dc_norm(1,i)
3057 uzder(1,3,2)= dc_norm(2,i)
3058 uzder(2,3,2)=-dc_norm(1,i)
3060 C Compute the Y-axis
3062 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
3063 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
3064 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
3066 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
3069 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
3070 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
3073 c write (iout,*) 'facy',facy,
3074 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3075 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3077 uy(k,i)=facy*uy(k,i)
3079 C Compute the derivatives of uy
3082 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
3083 & -dc_norm(k,i)*dc_norm(j,i+1)
3084 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3086 c uyder(j,j,1)=uyder(j,j,1)-costh
3087 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
3088 uyder(j,j,1)=uyder(j,j,1)
3089 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
3090 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
3096 uygrad(l,k,j,i)=uyder(l,k,j)
3097 uzgrad(l,k,j,i)=uzder(l,k,j)
3101 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3102 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3103 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3104 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3111 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
3112 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
3119 C-----------------------------------------------------------------------------
3120 subroutine check_vecgrad
3121 implicit real*8 (a-h,o-z)
3122 include 'DIMENSIONS'
3123 include 'sizesclu.dat'
3124 include 'COMMON.IOUNITS'
3125 include 'COMMON.GEO'
3126 include 'COMMON.VAR'
3127 include 'COMMON.LOCAL'
3128 include 'COMMON.CHAIN'
3129 include 'COMMON.VECTORS'
3130 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
3131 dimension uyt(3,maxres),uzt(3,maxres)
3132 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
3133 double precision delta /1.0d-7/
3136 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
3137 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
3138 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
3139 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
3140 cd & (dc_norm(if90,i),if90=1,3)
3141 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
3142 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
3143 cd write(iout,'(a)')
3149 uygradt(l,k,j,i)=uygrad(l,k,j,i)
3150 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
3163 cd write (iout,*) 'i=',i
3165 erij(k)=dc_norm(k,i)
3169 dc_norm(k,i)=erij(k)
3171 dc_norm(j,i)=dc_norm(j,i)+delta
3172 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
3174 c dc_norm(k,i)=dc_norm(k,i)/fac
3176 c write (iout,*) (dc_norm(k,i),k=1,3)
3177 c write (iout,*) (erij(k),k=1,3)
3180 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
3181 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
3182 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
3183 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
3185 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3186 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
3187 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
3190 dc_norm(k,i)=erij(k)
3193 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3194 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
3195 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
3196 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3197 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
3198 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
3199 cd write (iout,'(a)')
3204 C--------------------------------------------------------------------------
3205 subroutine set_matrices
3206 implicit real*8 (a-h,o-z)
3207 include 'DIMENSIONS'
3208 include 'sizesclu.dat'
3209 include 'COMMON.IOUNITS'
3210 include 'COMMON.GEO'
3211 include 'COMMON.VAR'
3212 include 'COMMON.LOCAL'
3213 include 'COMMON.CHAIN'
3214 include 'COMMON.DERIV'
3215 include 'COMMON.INTERACT'
3216 include 'COMMON.CONTACTS'
3217 include 'COMMON.TORSION'
3218 include 'COMMON.VECTORS'
3219 include 'COMMON.FFIELD'
3220 double precision auxvec(2),auxmat(2,2)
3222 C Compute the virtual-bond-torsional-angle dependent quantities needed
3223 C to calculate the el-loc multibody terms of various order.
3226 if (i .lt. nres+1) then
3263 if (i .gt. 3 .and. i .lt. nres+1) then
3264 obrot_der(1,i-2)=-sin1
3265 obrot_der(2,i-2)= cos1
3266 Ugder(1,1,i-2)= sin1
3267 Ugder(1,2,i-2)=-cos1
3268 Ugder(2,1,i-2)=-cos1
3269 Ugder(2,2,i-2)=-sin1
3272 obrot2_der(1,i-2)=-dwasin2
3273 obrot2_der(2,i-2)= dwacos2
3274 Ug2der(1,1,i-2)= dwasin2
3275 Ug2der(1,2,i-2)=-dwacos2
3276 Ug2der(2,1,i-2)=-dwacos2
3277 Ug2der(2,2,i-2)=-dwasin2
3279 obrot_der(1,i-2)=0.0d0
3280 obrot_der(2,i-2)=0.0d0
3281 Ugder(1,1,i-2)=0.0d0
3282 Ugder(1,2,i-2)=0.0d0
3283 Ugder(2,1,i-2)=0.0d0
3284 Ugder(2,2,i-2)=0.0d0
3285 obrot2_der(1,i-2)=0.0d0
3286 obrot2_der(2,i-2)=0.0d0
3287 Ug2der(1,1,i-2)=0.0d0
3288 Ug2der(1,2,i-2)=0.0d0
3289 Ug2der(2,1,i-2)=0.0d0
3290 Ug2der(2,2,i-2)=0.0d0
3292 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
3293 iti = itortyp(itype(i-2))
3297 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3298 iti1 = itortyp(itype(i-1))
3302 cd write (iout,*) '*******i',i,' iti1',iti
3303 cd write (iout,*) 'b1',b1(:,iti)
3304 cd write (iout,*) 'b2',b2(:,iti)
3305 cd write (iout,*) 'Ug',Ug(:,:,i-2)
3306 if (i .gt. iatel_s+2) then
3307 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
3308 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
3309 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
3310 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
3311 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3312 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
3313 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
3323 DtUg2(l,k,i-2)=0.0d0
3327 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
3328 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
3329 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3330 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3331 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3332 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3333 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3335 muder(k,i-2)=Ub2der(k,i-2)
3337 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3338 iti1 = itortyp(itype(i-1))
3343 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
3345 C Vectors and matrices dependent on a single virtual-bond dihedral.
3346 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
3347 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3348 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3349 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3350 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3351 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3352 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3353 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3354 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3355 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
3356 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
3358 C Matrices dependent on two consecutive virtual-bond dihedrals.
3359 C The order of matrices is from left to right.
3361 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3362 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3363 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3364 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3365 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3366 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3367 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3368 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3371 cd iti = itortyp(itype(i))
3374 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3375 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3380 C--------------------------------------------------------------------------
3381 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3383 C This subroutine calculates the average interaction energy and its gradient
3384 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3385 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3386 C The potential depends both on the distance of peptide-group centers and on
3387 C the orientation of the CA-CA virtual bonds.
3389 implicit real*8 (a-h,o-z)
3390 include 'DIMENSIONS'
3391 include 'sizesclu.dat'
3392 include 'COMMON.CONTROL'
3393 include 'COMMON.IOUNITS'
3394 include 'COMMON.GEO'
3395 include 'COMMON.VAR'
3396 include 'COMMON.LOCAL'
3397 include 'COMMON.CHAIN'
3398 include 'COMMON.DERIV'
3399 include 'COMMON.INTERACT'
3400 include 'COMMON.CONTACTS'
3401 include 'COMMON.TORSION'
3402 include 'COMMON.VECTORS'
3403 include 'COMMON.FFIELD'
3404 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3405 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3406 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3407 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3408 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
3409 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3410 double precision scal_el /0.5d0/
3412 C 13-go grudnia roku pamietnego...
3413 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3414 & 0.0d0,1.0d0,0.0d0,
3415 & 0.0d0,0.0d0,1.0d0/
3416 cd write(iout,*) 'In EELEC'
3418 cd write(iout,*) 'Type',i
3419 cd write(iout,*) 'B1',B1(:,i)
3420 cd write(iout,*) 'B2',B2(:,i)
3421 cd write(iout,*) 'CC',CC(:,:,i)
3422 cd write(iout,*) 'DD',DD(:,:,i)
3423 cd write(iout,*) 'EE',EE(:,:,i)
3425 cd call check_vecgrad
3427 if (icheckgrad.eq.1) then
3429 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3431 dc_norm(k,i)=dc(k,i)*fac
3433 c write (iout,*) 'i',i,' fac',fac
3436 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3437 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3438 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3439 cd if (wel_loc.gt.0.0d0) then
3440 if (icheckgrad.eq.1) then
3441 call vec_and_deriv_test
3448 cd write (iout,*) 'i=',i
3450 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3453 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3454 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3467 cd print '(a)','Enter EELEC'
3468 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3470 gel_loc_loc(i)=0.0d0
3473 do i=iatel_s,iatel_e
3474 if (itel(i).eq.0) goto 1215
3478 dx_normi=dc_norm(1,i)
3479 dy_normi=dc_norm(2,i)
3480 dz_normi=dc_norm(3,i)
3481 xmedi=c(1,i)+0.5d0*dxi
3482 ymedi=c(2,i)+0.5d0*dyi
3483 zmedi=c(3,i)+0.5d0*dzi
3485 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3486 do j=ielstart(i),ielend(i)
3487 if (itel(j).eq.0) goto 1216
3491 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3492 aaa=app(iteli,itelj)
3493 bbb=bpp(iteli,itelj)
3494 C Diagnostics only!!!
3500 ael6i=ael6(iteli,itelj)
3501 ael3i=ael3(iteli,itelj)
3505 dx_normj=dc_norm(1,j)
3506 dy_normj=dc_norm(2,j)
3507 dz_normj=dc_norm(3,j)
3508 xj=c(1,j)+0.5D0*dxj-xmedi
3509 yj=c(2,j)+0.5D0*dyj-ymedi
3510 zj=c(3,j)+0.5D0*dzj-zmedi
3511 rij=xj*xj+yj*yj+zj*zj
3517 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3518 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3519 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3520 fac=cosa-3.0D0*cosb*cosg
3522 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3523 if (j.eq.i+2) ev1=scal_el*ev1
3528 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3531 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
3532 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3533 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3536 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3537 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3538 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3539 cd & xmedi,ymedi,zmedi,xj,yj,zj
3541 C Calculate contributions to the Cartesian gradient.
3544 facvdw=-6*rrmij*(ev1+evdwij)
3545 facel=-3*rrmij*(el1+eesij)
3552 * Radial derivatives. First process both termini of the fragment (i,j)
3559 gelc(k,i)=gelc(k,i)+ghalf
3560 gelc(k,j)=gelc(k,j)+ghalf
3563 * Loop over residues i+1 thru j-1.
3567 gelc(l,k)=gelc(l,k)+ggg(l)
3575 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3576 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3579 * Loop over residues i+1 thru j-1.
3583 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3590 fac=-3*rrmij*(facvdw+facvdw+facel)
3596 * Radial derivatives. First process both termini of the fragment (i,j)
3603 gelc(k,i)=gelc(k,i)+ghalf
3604 gelc(k,j)=gelc(k,j)+ghalf
3607 * Loop over residues i+1 thru j-1.
3611 gelc(l,k)=gelc(l,k)+ggg(l)
3618 ecosa=2.0D0*fac3*fac1+fac4
3621 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3622 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3624 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3625 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3627 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3628 cd & (dcosg(k),k=1,3)
3630 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3634 gelc(k,i)=gelc(k,i)+ghalf
3635 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3636 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3637 gelc(k,j)=gelc(k,j)+ghalf
3638 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3639 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3643 gelc(l,k)=gelc(l,k)+ggg(l)
3648 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3649 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3650 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3652 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3653 C energy of a peptide unit is assumed in the form of a second-order
3654 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3655 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3656 C are computed for EVERY pair of non-contiguous peptide groups.
3658 if (j.lt.nres-1) then
3669 muij(kkk)=mu(k,i)*mu(l,j)
3672 cd write (iout,*) 'EELEC: i',i,' j',j
3673 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3674 cd write(iout,*) 'muij',muij
3675 ury=scalar(uy(1,i),erij)
3676 urz=scalar(uz(1,i),erij)
3677 vry=scalar(uy(1,j),erij)
3678 vrz=scalar(uz(1,j),erij)
3679 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3680 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3681 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3682 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3683 C For diagnostics only
3688 fac=dsqrt(-ael6i)*r3ij
3689 cd write (2,*) 'fac=',fac
3690 C For diagnostics only
3696 cd write (iout,'(4i5,4f10.5)')
3697 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3698 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3699 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
3700 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
3701 cd write (iout,'(4f10.5)')
3702 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3703 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3704 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3705 cd write (iout,'(2i3,9f10.5/)') i,j,
3706 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3708 C Derivatives of the elements of A in virtual-bond vectors
3709 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3716 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3717 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3718 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3719 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3720 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3721 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3722 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3723 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3724 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3725 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3726 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3727 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3737 C Compute radial contributions to the gradient
3759 C Add the contributions coming from er
3762 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3763 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3764 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3765 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3768 C Derivatives in DC(i)
3769 ghalf1=0.5d0*agg(k,1)
3770 ghalf2=0.5d0*agg(k,2)
3771 ghalf3=0.5d0*agg(k,3)
3772 ghalf4=0.5d0*agg(k,4)
3773 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3774 & -3.0d0*uryg(k,2)*vry)+ghalf1
3775 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3776 & -3.0d0*uryg(k,2)*vrz)+ghalf2
3777 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3778 & -3.0d0*urzg(k,2)*vry)+ghalf3
3779 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3780 & -3.0d0*urzg(k,2)*vrz)+ghalf4
3781 C Derivatives in DC(i+1)
3782 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3783 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
3784 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3785 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
3786 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3787 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
3788 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3789 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
3790 C Derivatives in DC(j)
3791 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3792 & -3.0d0*vryg(k,2)*ury)+ghalf1
3793 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3794 & -3.0d0*vrzg(k,2)*ury)+ghalf2
3795 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3796 & -3.0d0*vryg(k,2)*urz)+ghalf3
3797 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3798 & -3.0d0*vrzg(k,2)*urz)+ghalf4
3799 C Derivatives in DC(j+1) or DC(nres-1)
3800 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3801 & -3.0d0*vryg(k,3)*ury)
3802 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3803 & -3.0d0*vrzg(k,3)*ury)
3804 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3805 & -3.0d0*vryg(k,3)*urz)
3806 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3807 & -3.0d0*vrzg(k,3)*urz)
3812 C Derivatives in DC(i+1)
3813 cd aggi1(k,1)=agg(k,1)
3814 cd aggi1(k,2)=agg(k,2)
3815 cd aggi1(k,3)=agg(k,3)
3816 cd aggi1(k,4)=agg(k,4)
3817 C Derivatives in DC(j)
3822 C Derivatives in DC(j+1)
3827 if (j.eq.nres-1 .and. i.lt.j-2) then
3829 aggj1(k,l)=aggj1(k,l)+agg(k,l)
3830 cd aggj1(k,l)=agg(k,l)
3836 C Check the loc-el terms by numerical integration
3846 aggi(k,l)=-aggi(k,l)
3847 aggi1(k,l)=-aggi1(k,l)
3848 aggj(k,l)=-aggj(k,l)
3849 aggj1(k,l)=-aggj1(k,l)
3852 if (j.lt.nres-1) then
3858 aggi(k,l)=-aggi(k,l)
3859 aggi1(k,l)=-aggi1(k,l)
3860 aggj(k,l)=-aggj(k,l)
3861 aggj1(k,l)=-aggj1(k,l)
3872 aggi(k,l)=-aggi(k,l)
3873 aggi1(k,l)=-aggi1(k,l)
3874 aggj(k,l)=-aggj(k,l)
3875 aggj1(k,l)=-aggj1(k,l)
3881 IF (wel_loc.gt.0.0d0) THEN
3882 C Contribution to the local-electrostatic energy coming from the i-j pair
3883 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3885 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3886 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3887 eel_loc=eel_loc+eel_loc_ij
3888 C Partial derivatives in virtual-bond dihedral angles gamma
3891 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3892 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3893 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3894 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3895 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3896 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3897 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
3898 cd write(iout,*) 'agg ',agg
3899 cd write(iout,*) 'aggi ',aggi
3900 cd write(iout,*) 'aggi1',aggi1
3901 cd write(iout,*) 'aggj ',aggj
3902 cd write(iout,*) 'aggj1',aggj1
3904 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3906 ggg(l)=agg(l,1)*muij(1)+
3907 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3911 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3914 C Remaining derivatives of eello
3916 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3917 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3918 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3919 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3920 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3921 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3922 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3923 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3927 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3928 C Contributions from turns
3933 call eturn34(i,j,eello_turn3,eello_turn4)
3935 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3936 if (j.gt.i+1 .and. num_conti.le.maxconts) then
3938 C Calculate the contact function. The ith column of the array JCONT will
3939 C contain the numbers of atoms that make contacts with the atom I (of numbers
3940 C greater than I). The arrays FACONT and GACONT will contain the values of
3941 C the contact function and its derivative.
3942 c r0ij=1.02D0*rpp(iteli,itelj)
3943 c r0ij=1.11D0*rpp(iteli,itelj)
3944 r0ij=2.20D0*rpp(iteli,itelj)
3945 c r0ij=1.55D0*rpp(iteli,itelj)
3946 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3947 if (fcont.gt.0.0D0) then
3948 num_conti=num_conti+1
3949 if (num_conti.gt.maxconts) then
3950 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3951 & ' will skip next contacts for this conf.'
3953 jcont_hb(num_conti,i)=j
3954 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3955 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3956 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3958 d_cont(num_conti,i)=rij
3959 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3960 C --- Electrostatic-interaction matrix ---
3961 a_chuj(1,1,num_conti,i)=a22
3962 a_chuj(1,2,num_conti,i)=a23
3963 a_chuj(2,1,num_conti,i)=a32
3964 a_chuj(2,2,num_conti,i)=a33
3965 C --- Gradient of rij
3967 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3970 c a_chuj(1,1,num_conti,i)=-0.61d0
3971 c a_chuj(1,2,num_conti,i)= 0.4d0
3972 c a_chuj(2,1,num_conti,i)= 0.65d0
3973 c a_chuj(2,2,num_conti,i)= 0.50d0
3974 c else if (i.eq.2) then
3975 c a_chuj(1,1,num_conti,i)= 0.0d0
3976 c a_chuj(1,2,num_conti,i)= 0.0d0
3977 c a_chuj(2,1,num_conti,i)= 0.0d0
3978 c a_chuj(2,2,num_conti,i)= 0.0d0
3980 C --- and its gradients
3981 cd write (iout,*) 'i',i,' j',j
3983 cd write (iout,*) 'iii 1 kkk',kkk
3984 cd write (iout,*) agg(kkk,:)
3987 cd write (iout,*) 'iii 2 kkk',kkk
3988 cd write (iout,*) aggi(kkk,:)
3991 cd write (iout,*) 'iii 3 kkk',kkk
3992 cd write (iout,*) aggi1(kkk,:)
3995 cd write (iout,*) 'iii 4 kkk',kkk
3996 cd write (iout,*) aggj(kkk,:)
3999 cd write (iout,*) 'iii 5 kkk',kkk
4000 cd write (iout,*) aggj1(kkk,:)
4007 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4008 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4009 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4010 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4011 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4013 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
4019 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4020 C Calculate contact energies
4022 wij=cosa-3.0D0*cosb*cosg
4025 c fac3=dsqrt(-ael6i)/r0ij**3
4026 fac3=dsqrt(-ael6i)*r3ij
4027 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4028 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4030 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4031 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4032 C Diagnostics. Comment out or remove after debugging!
4033 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4034 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4035 c ees0m(num_conti,i)=0.0D0
4037 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4038 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4039 facont_hb(num_conti,i)=fcont
4041 C Angular derivatives of the contact function
4042 ees0pij1=fac3/ees0pij
4043 ees0mij1=fac3/ees0mij
4044 fac3p=-3.0D0*fac3*rrmij
4045 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4046 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4048 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4049 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4050 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4051 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4052 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4053 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4054 ecosap=ecosa1+ecosa2
4055 ecosbp=ecosb1+ecosb2
4056 ecosgp=ecosg1+ecosg2
4057 ecosam=ecosa1-ecosa2
4058 ecosbm=ecosb1-ecosb2
4059 ecosgm=ecosg1-ecosg2
4068 fprimcont=fprimcont/rij
4069 cd facont_hb(num_conti,i)=1.0D0
4070 C Following line is for diagnostics.
4073 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4074 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4077 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4078 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4080 gggp(1)=gggp(1)+ees0pijp*xj
4081 gggp(2)=gggp(2)+ees0pijp*yj
4082 gggp(3)=gggp(3)+ees0pijp*zj
4083 gggm(1)=gggm(1)+ees0mijp*xj
4084 gggm(2)=gggm(2)+ees0mijp*yj
4085 gggm(3)=gggm(3)+ees0mijp*zj
4086 C Derivatives due to the contact function
4087 gacont_hbr(1,num_conti,i)=fprimcont*xj
4088 gacont_hbr(2,num_conti,i)=fprimcont*yj
4089 gacont_hbr(3,num_conti,i)=fprimcont*zj
4091 ghalfp=0.5D0*gggp(k)
4092 ghalfm=0.5D0*gggm(k)
4093 gacontp_hb1(k,num_conti,i)=ghalfp
4094 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4095 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4096 gacontp_hb2(k,num_conti,i)=ghalfp
4097 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4098 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4099 gacontp_hb3(k,num_conti,i)=gggp(k)
4100 gacontm_hb1(k,num_conti,i)=ghalfm
4101 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4102 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4103 gacontm_hb2(k,num_conti,i)=ghalfm
4104 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4105 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4106 gacontm_hb3(k,num_conti,i)=gggm(k)
4109 C Diagnostics. Comment out or remove after debugging!
4111 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4112 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4113 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4114 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4115 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4116 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4119 endif ! num_conti.le.maxconts
4124 num_cont_hb(i)=num_conti
4128 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
4129 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
4131 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
4132 ccc eel_loc=eel_loc+eello_turn3
4135 C-----------------------------------------------------------------------------
4136 subroutine eturn34(i,j,eello_turn3,eello_turn4)
4137 C Third- and fourth-order contributions from turns
4138 implicit real*8 (a-h,o-z)
4139 include 'DIMENSIONS'
4140 include 'sizesclu.dat'
4141 include 'COMMON.IOUNITS'
4142 include 'COMMON.GEO'
4143 include 'COMMON.VAR'
4144 include 'COMMON.LOCAL'
4145 include 'COMMON.CHAIN'
4146 include 'COMMON.DERIV'
4147 include 'COMMON.INTERACT'
4148 include 'COMMON.CONTACTS'
4149 include 'COMMON.TORSION'
4150 include 'COMMON.VECTORS'
4151 include 'COMMON.FFIELD'
4153 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4154 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4155 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
4156 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4157 & aggj(3,4),aggj1(3,4),a_temp(2,2)
4158 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
4160 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4162 C Third-order contributions
4169 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4170 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4171 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4172 call transpose2(auxmat(1,1),auxmat1(1,1))
4173 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4174 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4175 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4176 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4177 cd & ' eello_turn3_num',4*eello_turn3_num
4179 C Derivatives in gamma(i)
4180 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4181 call transpose2(auxmat2(1,1),pizda(1,1))
4182 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4183 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4184 C Derivatives in gamma(i+1)
4185 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4186 call transpose2(auxmat2(1,1),pizda(1,1))
4187 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4188 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4189 & +0.5d0*(pizda(1,1)+pizda(2,2))
4190 C Cartesian derivatives
4192 a_temp(1,1)=aggi(l,1)
4193 a_temp(1,2)=aggi(l,2)
4194 a_temp(2,1)=aggi(l,3)
4195 a_temp(2,2)=aggi(l,4)
4196 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4197 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4198 & +0.5d0*(pizda(1,1)+pizda(2,2))
4199 a_temp(1,1)=aggi1(l,1)
4200 a_temp(1,2)=aggi1(l,2)
4201 a_temp(2,1)=aggi1(l,3)
4202 a_temp(2,2)=aggi1(l,4)
4203 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4204 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4205 & +0.5d0*(pizda(1,1)+pizda(2,2))
4206 a_temp(1,1)=aggj(l,1)
4207 a_temp(1,2)=aggj(l,2)
4208 a_temp(2,1)=aggj(l,3)
4209 a_temp(2,2)=aggj(l,4)
4210 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4211 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4212 & +0.5d0*(pizda(1,1)+pizda(2,2))
4213 a_temp(1,1)=aggj1(l,1)
4214 a_temp(1,2)=aggj1(l,2)
4215 a_temp(2,1)=aggj1(l,3)
4216 a_temp(2,2)=aggj1(l,4)
4217 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4218 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4219 & +0.5d0*(pizda(1,1)+pizda(2,2))
4222 else if (j.eq.i+3) then
4223 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4225 C Fourth-order contributions
4233 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4234 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4235 iti1=itortyp(itype(i+1))
4236 iti2=itortyp(itype(i+2))
4237 iti3=itortyp(itype(i+3))
4238 call transpose2(EUg(1,1,i+1),e1t(1,1))
4239 call transpose2(Eug(1,1,i+2),e2t(1,1))
4240 call transpose2(Eug(1,1,i+3),e3t(1,1))
4241 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4242 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4243 s1=scalar2(b1(1,iti2),auxvec(1))
4244 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4245 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4246 s2=scalar2(b1(1,iti1),auxvec(1))
4247 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4248 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4249 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4250 eello_turn4=eello_turn4-(s1+s2+s3)
4251 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4252 cd & ' eello_turn4_num',8*eello_turn4_num
4253 C Derivatives in gamma(i)
4255 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4256 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4257 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4258 s1=scalar2(b1(1,iti2),auxvec(1))
4259 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4260 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4261 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4262 C Derivatives in gamma(i+1)
4263 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4264 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4265 s2=scalar2(b1(1,iti1),auxvec(1))
4266 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4267 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4268 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4269 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4270 C Derivatives in gamma(i+2)
4271 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4272 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4273 s1=scalar2(b1(1,iti2),auxvec(1))
4274 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4275 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4276 s2=scalar2(b1(1,iti1),auxvec(1))
4277 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
4278 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4279 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4280 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4281 C Cartesian derivatives
4282 C Derivatives of this turn contributions in DC(i+2)
4283 if (j.lt.nres-1) then
4285 a_temp(1,1)=agg(l,1)
4286 a_temp(1,2)=agg(l,2)
4287 a_temp(2,1)=agg(l,3)
4288 a_temp(2,2)=agg(l,4)
4289 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4290 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4291 s1=scalar2(b1(1,iti2),auxvec(1))
4292 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4293 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4294 s2=scalar2(b1(1,iti1),auxvec(1))
4295 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4296 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4297 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4299 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4302 C Remaining derivatives of this turn contribution
4304 a_temp(1,1)=aggi(l,1)
4305 a_temp(1,2)=aggi(l,2)
4306 a_temp(2,1)=aggi(l,3)
4307 a_temp(2,2)=aggi(l,4)
4308 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4309 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4310 s1=scalar2(b1(1,iti2),auxvec(1))
4311 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4312 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4313 s2=scalar2(b1(1,iti1),auxvec(1))
4314 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4315 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4316 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4317 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4318 a_temp(1,1)=aggi1(l,1)
4319 a_temp(1,2)=aggi1(l,2)
4320 a_temp(2,1)=aggi1(l,3)
4321 a_temp(2,2)=aggi1(l,4)
4322 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4323 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4324 s1=scalar2(b1(1,iti2),auxvec(1))
4325 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4326 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4327 s2=scalar2(b1(1,iti1),auxvec(1))
4328 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4329 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4330 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4331 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4332 a_temp(1,1)=aggj(l,1)
4333 a_temp(1,2)=aggj(l,2)
4334 a_temp(2,1)=aggj(l,3)
4335 a_temp(2,2)=aggj(l,4)
4336 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4337 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4338 s1=scalar2(b1(1,iti2),auxvec(1))
4339 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4340 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4341 s2=scalar2(b1(1,iti1),auxvec(1))
4342 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4343 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4344 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4345 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4346 a_temp(1,1)=aggj1(l,1)
4347 a_temp(1,2)=aggj1(l,2)
4348 a_temp(2,1)=aggj1(l,3)
4349 a_temp(2,2)=aggj1(l,4)
4350 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4351 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4352 s1=scalar2(b1(1,iti2),auxvec(1))
4353 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4354 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4355 s2=scalar2(b1(1,iti1),auxvec(1))
4356 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4357 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4358 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4359 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4365 C-----------------------------------------------------------------------------
4366 subroutine vecpr(u,v,w)
4367 implicit real*8(a-h,o-z)
4368 dimension u(3),v(3),w(3)
4369 w(1)=u(2)*v(3)-u(3)*v(2)
4370 w(2)=-u(1)*v(3)+u(3)*v(1)
4371 w(3)=u(1)*v(2)-u(2)*v(1)
4374 C-----------------------------------------------------------------------------
4375 subroutine unormderiv(u,ugrad,unorm,ungrad)
4376 C This subroutine computes the derivatives of a normalized vector u, given
4377 C the derivatives computed without normalization conditions, ugrad. Returns
4380 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4381 double precision vec(3)
4382 double precision scalar
4384 c write (2,*) 'ugrad',ugrad
4387 vec(i)=scalar(ugrad(1,i),u(1))
4389 c write (2,*) 'vec',vec
4392 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4395 c write (2,*) 'ungrad',ungrad
4398 C-----------------------------------------------------------------------------
4399 subroutine escp(evdw2,evdw2_14)
4401 C This subroutine calculates the excluded-volume interaction energy between
4402 C peptide-group centers and side chains and its gradient in virtual-bond and
4403 C side-chain vectors.
4405 implicit real*8 (a-h,o-z)
4406 include 'DIMENSIONS'
4407 include 'sizesclu.dat'
4408 include 'COMMON.GEO'
4409 include 'COMMON.VAR'
4410 include 'COMMON.LOCAL'
4411 include 'COMMON.CHAIN'
4412 include 'COMMON.DERIV'
4413 include 'COMMON.INTERACT'
4414 include 'COMMON.FFIELD'
4415 include 'COMMON.IOUNITS'
4419 cd print '(a)','Enter ESCP'
4420 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4421 c & ' scal14',scal14
4422 do i=iatscp_s,iatscp_e
4424 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4425 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4426 if (iteli.eq.0) goto 1225
4427 xi=0.5D0*(c(1,i)+c(1,i+1))
4428 yi=0.5D0*(c(2,i)+c(2,i+1))
4429 zi=0.5D0*(c(3,i)+c(3,i+1))
4431 do iint=1,nscp_gr(i)
4433 do j=iscpstart(i,iint),iscpend(i,iint)
4435 C Uncomment following three lines for SC-p interactions
4439 C Uncomment following three lines for Ca-p interactions
4443 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4445 e1=fac*fac*aad(itypj,iteli)
4446 e2=fac*bad(itypj,iteli)
4447 if (iabs(j-i) .le. 2) then
4450 evdw2_14=evdw2_14+e1+e2
4453 c write (iout,*) i,j,evdwij
4457 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4459 fac=-(evdwij+e1)*rrij
4464 cd write (iout,*) 'j<i'
4465 C Uncomment following three lines for SC-p interactions
4467 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4470 cd write (iout,*) 'j>i'
4473 C Uncomment following line for SC-p interactions
4474 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4478 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4482 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4483 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4486 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4496 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4497 gradx_scp(j,i)=expon*gradx_scp(j,i)
4500 C******************************************************************************
4504 C To save time the factor EXPON has been extracted from ALL components
4505 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4508 C******************************************************************************
4511 C--------------------------------------------------------------------------
4512 subroutine edis(ehpb)
4514 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4516 implicit real*8 (a-h,o-z)
4517 include 'DIMENSIONS'
4518 include 'COMMON.SBRIDGE'
4519 include 'COMMON.CHAIN'
4520 include 'COMMON.DERIV'
4521 include 'COMMON.VAR'
4522 include 'COMMON.INTERACT'
4523 include 'COMMON.IOUNITS'
4526 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4527 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4528 if (link_end.eq.0) return
4529 do i=link_start,link_end
4530 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4531 C CA-CA distance used in regularization of structure.
4534 C iii and jjj point to the residues for which the distance is assigned.
4535 if (ii.gt.nres) then
4542 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4543 c & dhpb(i),dhpb1(i),forcon(i)
4544 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4545 C distance and angle dependent SS bond potential.
4546 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4547 call ssbond_ene(iii,jjj,eij)
4549 cd write (iout,*) "eij",eij
4550 else if (ii.gt.nres .and. jj.gt.nres) then
4551 c Restraints from contact prediction
4553 if (dhpb1(i).gt.0.0d0) then
4554 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4555 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4556 c write (iout,*) "beta nmr",
4557 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4561 C Get the force constant corresponding to this distance.
4563 C Calculate the contribution to energy.
4564 ehpb=ehpb+waga*rdis*rdis
4565 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4567 C Evaluate gradient.
4572 ggg(j)=fac*(c(j,jj)-c(j,ii))
4575 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4576 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4579 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4580 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4583 C Calculate the distance between the two points and its difference from the
4586 if (dhpb1(i).gt.0.0d0) then
4587 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4588 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4589 c write (iout,*) "alph nmr",
4590 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4593 C Get the force constant corresponding to this distance.
4595 C Calculate the contribution to energy.
4596 ehpb=ehpb+waga*rdis*rdis
4597 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4599 C Evaluate gradient.
4603 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4604 cd & ' waga=',waga,' fac=',fac
4606 ggg(j)=fac*(c(j,jj)-c(j,ii))
4608 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4609 C If this is a SC-SC distance, we need to calculate the contributions to the
4610 C Cartesian gradient in the SC vectors (ghpbx).
4613 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4614 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4618 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4619 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4626 C--------------------------------------------------------------------------
4627 subroutine ssbond_ene(i,j,eij)
4629 C Calculate the distance and angle dependent SS-bond potential energy
4630 C using a free-energy function derived based on RHF/6-31G** ab initio
4631 C calculations of diethyl disulfide.
4633 C A. Liwo and U. Kozlowska, 11/24/03
4635 implicit real*8 (a-h,o-z)
4636 include 'DIMENSIONS'
4637 include 'sizesclu.dat'
4638 include 'COMMON.SBRIDGE'
4639 include 'COMMON.CHAIN'
4640 include 'COMMON.DERIV'
4641 include 'COMMON.LOCAL'
4642 include 'COMMON.INTERACT'
4643 include 'COMMON.VAR'
4644 include 'COMMON.IOUNITS'
4645 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4650 dxi=dc_norm(1,nres+i)
4651 dyi=dc_norm(2,nres+i)
4652 dzi=dc_norm(3,nres+i)
4653 dsci_inv=dsc_inv(itypi)
4655 dscj_inv=dsc_inv(itypj)
4659 dxj=dc_norm(1,nres+j)
4660 dyj=dc_norm(2,nres+j)
4661 dzj=dc_norm(3,nres+j)
4662 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4667 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4668 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4669 om12=dxi*dxj+dyi*dyj+dzi*dzj
4671 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4672 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4678 deltat12=om2-om1+2.0d0
4680 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4681 & +akct*deltad*deltat12
4682 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4683 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4684 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4685 c & " deltat12",deltat12," eij",eij
4686 ed=2*akcm*deltad+akct*deltat12
4688 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4689 eom1=-2*akth*deltat1-pom1-om2*pom2
4690 eom2= 2*akth*deltat2+pom1-om1*pom2
4693 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4696 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4697 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4698 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4699 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4702 C Calculate the components of the gradient in DC and X
4706 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4711 C--------------------------------------------------------------------------
4712 subroutine ebond(estr)
4714 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4716 implicit real*8 (a-h,o-z)
4717 include 'DIMENSIONS'
4718 include 'COMMON.LOCAL'
4719 include 'COMMON.GEO'
4720 include 'COMMON.INTERACT'
4721 include 'COMMON.DERIV'
4722 include 'COMMON.VAR'
4723 include 'COMMON.CHAIN'
4724 include 'COMMON.IOUNITS'
4725 include 'COMMON.NAMES'
4726 include 'COMMON.FFIELD'
4727 include 'COMMON.CONTROL'
4728 double precision u(3),ud(3)
4731 diff = vbld(i)-vbldp0
4732 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4735 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4740 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4747 diff=vbld(i+nres)-vbldsc0(1,iti)
4748 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4749 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4750 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4752 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4756 diff=vbld(i+nres)-vbldsc0(j,iti)
4757 ud(j)=aksc(j,iti)*diff
4758 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4772 uprod2=uprod2*u(k)*u(k)
4776 usumsqder=usumsqder+ud(j)*uprod2
4778 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4779 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4780 estr=estr+uprod/usum
4782 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4790 C--------------------------------------------------------------------------
4791 subroutine ebend(etheta)
4793 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4794 C angles gamma and its derivatives in consecutive thetas and gammas.
4796 implicit real*8 (a-h,o-z)
4797 include 'DIMENSIONS'
4798 include 'sizesclu.dat'
4799 include 'COMMON.LOCAL'
4800 include 'COMMON.GEO'
4801 include 'COMMON.INTERACT'
4802 include 'COMMON.DERIV'
4803 include 'COMMON.VAR'
4804 include 'COMMON.CHAIN'
4805 include 'COMMON.IOUNITS'
4806 include 'COMMON.NAMES'
4807 include 'COMMON.FFIELD'
4808 common /calcthet/ term1,term2,termm,diffak,ratak,
4809 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4810 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4811 double precision y(2),z(2)
4813 time11=dexp(-2*time)
4816 c write (iout,*) "nres",nres
4817 c write (*,'(a,i2)') 'EBEND ICG=',icg
4818 c write (iout,*) ithet_start,ithet_end
4819 do i=ithet_start,ithet_end
4820 C Zero the energy function and its derivative at 0 or pi.
4821 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4823 c if (i.gt.ithet_start .and.
4824 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
4825 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
4833 c if (i.lt.nres .and. itel(i).ne.0) then
4845 call proc_proc(phii,icrc)
4846 if (icrc.eq.1) phii=150.0
4860 call proc_proc(phii1,icrc)
4861 if (icrc.eq.1) phii1=150.0
4873 C Calculate the "mean" value of theta from the part of the distribution
4874 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4875 C In following comments this theta will be referred to as t_c.
4876 thet_pred_mean=0.0d0
4880 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4882 c write (iout,*) "thet_pred_mean",thet_pred_mean
4883 dthett=thet_pred_mean*ssd
4884 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4885 c write (iout,*) "thet_pred_mean",thet_pred_mean
4886 C Derivatives of the "mean" values in gamma1 and gamma2.
4887 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4888 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4889 if (theta(i).gt.pi-delta) then
4890 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4892 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4893 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4894 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4896 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4898 else if (theta(i).lt.delta) then
4899 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4900 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4901 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4903 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4904 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4907 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4910 etheta=etheta+ethetai
4911 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4912 c & rad2deg*phii,rad2deg*phii1,ethetai
4913 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4914 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4915 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4918 C Ufff.... We've done all this!!!
4921 C---------------------------------------------------------------------------
4922 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4924 implicit real*8 (a-h,o-z)
4925 include 'DIMENSIONS'
4926 include 'COMMON.LOCAL'
4927 include 'COMMON.IOUNITS'
4928 common /calcthet/ term1,term2,termm,diffak,ratak,
4929 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4930 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4931 C Calculate the contributions to both Gaussian lobes.
4932 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4933 C The "polynomial part" of the "standard deviation" of this part of
4937 sig=sig*thet_pred_mean+polthet(j,it)
4939 C Derivative of the "interior part" of the "standard deviation of the"
4940 C gamma-dependent Gaussian lobe in t_c.
4941 sigtc=3*polthet(3,it)
4943 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4946 C Set the parameters of both Gaussian lobes of the distribution.
4947 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4948 fac=sig*sig+sigc0(it)
4951 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4952 sigsqtc=-4.0D0*sigcsq*sigtc
4953 c print *,i,sig,sigtc,sigsqtc
4954 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4955 sigtc=-sigtc/(fac*fac)
4956 C Following variable is sigma(t_c)**(-2)
4957 sigcsq=sigcsq*sigcsq
4959 sig0inv=1.0D0/sig0i**2
4960 delthec=thetai-thet_pred_mean
4961 delthe0=thetai-theta0i
4962 term1=-0.5D0*sigcsq*delthec*delthec
4963 term2=-0.5D0*sig0inv*delthe0*delthe0
4964 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4965 C NaNs in taking the logarithm. We extract the largest exponent which is added
4966 C to the energy (this being the log of the distribution) at the end of energy
4967 C term evaluation for this virtual-bond angle.
4968 if (term1.gt.term2) then
4970 term2=dexp(term2-termm)
4974 term1=dexp(term1-termm)
4977 C The ratio between the gamma-independent and gamma-dependent lobes of
4978 C the distribution is a Gaussian function of thet_pred_mean too.
4979 diffak=gthet(2,it)-thet_pred_mean
4980 ratak=diffak/gthet(3,it)**2
4981 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4982 C Let's differentiate it in thet_pred_mean NOW.
4984 C Now put together the distribution terms to make complete distribution.
4985 termexp=term1+ak*term2
4986 termpre=sigc+ak*sig0i
4987 C Contribution of the bending energy from this theta is just the -log of
4988 C the sum of the contributions from the two lobes and the pre-exponential
4989 C factor. Simple enough, isn't it?
4990 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4991 C NOW the derivatives!!!
4992 C 6/6/97 Take into account the deformation.
4993 E_theta=(delthec*sigcsq*term1
4994 & +ak*delthe0*sig0inv*term2)/termexp
4995 E_tc=((sigtc+aktc*sig0i)/termpre
4996 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4997 & aktc*term2)/termexp)
5000 c-----------------------------------------------------------------------------
5001 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5002 implicit real*8 (a-h,o-z)
5003 include 'DIMENSIONS'
5004 include 'COMMON.LOCAL'
5005 include 'COMMON.IOUNITS'
5006 common /calcthet/ term1,term2,termm,diffak,ratak,
5007 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5008 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5009 delthec=thetai-thet_pred_mean
5010 delthe0=thetai-theta0i
5011 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5012 t3 = thetai-thet_pred_mean
5016 t14 = t12+t6*sigsqtc
5018 t21 = thetai-theta0i
5024 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5025 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5026 & *(-t12*t9-ak*sig0inv*t27)
5030 C--------------------------------------------------------------------------
5031 subroutine ebend(etheta)
5033 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5034 C angles gamma and its derivatives in consecutive thetas and gammas.
5035 C ab initio-derived potentials from
5036 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5038 implicit real*8 (a-h,o-z)
5039 include 'DIMENSIONS'
5040 include 'COMMON.LOCAL'
5041 include 'COMMON.GEO'
5042 include 'COMMON.INTERACT'
5043 include 'COMMON.DERIV'
5044 include 'COMMON.VAR'
5045 include 'COMMON.CHAIN'
5046 include 'COMMON.IOUNITS'
5047 include 'COMMON.NAMES'
5048 include 'COMMON.FFIELD'
5049 include 'COMMON.CONTROL'
5050 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5051 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5052 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5053 & sinph1ph2(maxdouble,maxdouble)
5054 logical lprn /.false./, lprn1 /.false./
5056 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5057 do i=ithet_start,ithet_end
5061 theti2=0.5d0*theta(i)
5062 ityp2=ithetyp(itype(i-1))
5064 coskt(k)=dcos(k*theti2)
5065 sinkt(k)=dsin(k*theti2)
5070 if (phii.ne.phii) phii=150.0
5074 ityp1=ithetyp(itype(i-2))
5076 cosph1(k)=dcos(k*phii)
5077 sinph1(k)=dsin(k*phii)
5090 if (phii1.ne.phii1) phii1=150.0
5095 ityp3=ithetyp(itype(i))
5097 cosph2(k)=dcos(k*phii1)
5098 sinph2(k)=dsin(k*phii1)
5108 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5109 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5111 ethetai=aa0thet(ityp1,ityp2,ityp3)
5114 ccl=cosph1(l)*cosph2(k-l)
5115 ssl=sinph1(l)*sinph2(k-l)
5116 scl=sinph1(l)*cosph2(k-l)
5117 csl=cosph1(l)*sinph2(k-l)
5118 cosph1ph2(l,k)=ccl-ssl
5119 cosph1ph2(k,l)=ccl+ssl
5120 sinph1ph2(l,k)=scl+csl
5121 sinph1ph2(k,l)=scl-csl
5125 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5126 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5127 write (iout,*) "coskt and sinkt"
5129 write (iout,*) k,coskt(k),sinkt(k)
5133 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
5134 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
5137 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
5138 & " ethetai",ethetai
5141 write (iout,*) "cosph and sinph"
5143 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5145 write (iout,*) "cosph1ph2 and sinph2ph2"
5148 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5149 & sinph1ph2(l,k),sinph1ph2(k,l)
5152 write(iout,*) "ethetai",ethetai
5156 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
5157 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
5158 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
5159 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
5160 ethetai=ethetai+sinkt(m)*aux
5161 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5162 dephii=dephii+k*sinkt(m)*(
5163 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
5164 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
5165 dephii1=dephii1+k*sinkt(m)*(
5166 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
5167 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
5169 & write (iout,*) "m",m," k",k," bbthet",
5170 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
5171 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
5172 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
5173 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5177 & write(iout,*) "ethetai",ethetai
5181 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5182 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
5183 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5184 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
5185 ethetai=ethetai+sinkt(m)*aux
5186 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5187 dephii=dephii+l*sinkt(m)*(
5188 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
5189 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5190 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5191 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5192 dephii1=dephii1+(k-l)*sinkt(m)*(
5193 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5194 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5195 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5196 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5198 write (iout,*) "m",m," k",k," l",l," ffthet",
5199 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5200 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5201 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5202 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5203 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5204 & cosph1ph2(k,l)*sinkt(m),
5205 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5211 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5212 & i,theta(i)*rad2deg,phii*rad2deg,
5213 & phii1*rad2deg,ethetai
5214 etheta=etheta+ethetai
5215 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5216 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5217 gloc(nphi+i-2,icg)=wang*dethetai
5223 c-----------------------------------------------------------------------------
5224 subroutine esc(escloc)
5225 C Calculate the local energy of a side chain and its derivatives in the
5226 C corresponding virtual-bond valence angles THETA and the spherical angles
5228 implicit real*8 (a-h,o-z)
5229 include 'DIMENSIONS'
5230 include 'sizesclu.dat'
5231 include 'COMMON.GEO'
5232 include 'COMMON.LOCAL'
5233 include 'COMMON.VAR'
5234 include 'COMMON.INTERACT'
5235 include 'COMMON.DERIV'
5236 include 'COMMON.CHAIN'
5237 include 'COMMON.IOUNITS'
5238 include 'COMMON.NAMES'
5239 include 'COMMON.FFIELD'
5240 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5241 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5242 common /sccalc/ time11,time12,time112,theti,it,nlobit
5245 c write (iout,'(a)') 'ESC'
5246 do i=loc_start,loc_end
5248 if (it.eq.10) goto 1
5250 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5251 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5252 theti=theta(i+1)-pipol
5256 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5258 if (x(2).gt.pi-delta) then
5262 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5264 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5265 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5267 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5268 & ddersc0(1),dersc(1))
5269 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5270 & ddersc0(3),dersc(3))
5272 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5274 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5275 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5276 & dersc0(2),esclocbi,dersc02)
5277 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5279 call splinthet(x(2),0.5d0*delta,ss,ssd)
5284 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5286 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5287 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5289 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5291 c write (iout,*) escloci
5292 else if (x(2).lt.delta) then
5296 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5298 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5299 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5301 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5302 & ddersc0(1),dersc(1))
5303 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5304 & ddersc0(3),dersc(3))
5306 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5308 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5309 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5310 & dersc0(2),esclocbi,dersc02)
5311 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5316 call splinthet(x(2),0.5d0*delta,ss,ssd)
5318 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5320 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5321 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5323 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5324 c write (iout,*) escloci
5326 call enesc(x,escloci,dersc,ddummy,.false.)
5329 escloc=escloc+escloci
5330 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5332 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5334 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5335 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5340 C---------------------------------------------------------------------------
5341 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5342 implicit real*8 (a-h,o-z)
5343 include 'DIMENSIONS'
5344 include 'COMMON.GEO'
5345 include 'COMMON.LOCAL'
5346 include 'COMMON.IOUNITS'
5347 common /sccalc/ time11,time12,time112,theti,it,nlobit
5348 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5349 double precision contr(maxlob,-1:1)
5351 c write (iout,*) 'it=',it,' nlobit=',nlobit
5355 if (mixed) ddersc(j)=0.0d0
5359 C Because of periodicity of the dependence of the SC energy in omega we have
5360 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5361 C To avoid underflows, first compute & store the exponents.
5369 z(k)=x(k)-censc(k,j,it)
5374 Axk=Axk+gaussc(l,k,j,it)*z(l)
5380 expfac=expfac+Ax(k,j,iii)*z(k)
5388 C As in the case of ebend, we want to avoid underflows in exponentiation and
5389 C subsequent NaNs and INFs in energy calculation.
5390 C Find the largest exponent
5394 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5398 cd print *,'it=',it,' emin=',emin
5400 C Compute the contribution to SC energy and derivatives
5404 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5405 cd print *,'j=',j,' expfac=',expfac
5406 escloc_i=escloc_i+expfac
5408 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5412 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5413 & +gaussc(k,2,j,it))*expfac
5420 dersc(1)=dersc(1)/cos(theti)**2
5421 ddersc(1)=ddersc(1)/cos(theti)**2
5424 escloci=-(dlog(escloc_i)-emin)
5426 dersc(j)=dersc(j)/escloc_i
5430 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5435 C------------------------------------------------------------------------------
5436 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5437 implicit real*8 (a-h,o-z)
5438 include 'DIMENSIONS'
5439 include 'COMMON.GEO'
5440 include 'COMMON.LOCAL'
5441 include 'COMMON.IOUNITS'
5442 common /sccalc/ time11,time12,time112,theti,it,nlobit
5443 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5444 double precision contr(maxlob)
5455 z(k)=x(k)-censc(k,j,it)
5461 Axk=Axk+gaussc(l,k,j,it)*z(l)
5467 expfac=expfac+Ax(k,j)*z(k)
5472 C As in the case of ebend, we want to avoid underflows in exponentiation and
5473 C subsequent NaNs and INFs in energy calculation.
5474 C Find the largest exponent
5477 if (emin.gt.contr(j)) emin=contr(j)
5481 C Compute the contribution to SC energy and derivatives
5485 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5486 escloc_i=escloc_i+expfac
5488 dersc(k)=dersc(k)+Ax(k,j)*expfac
5490 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5491 & +gaussc(1,2,j,it))*expfac
5495 dersc(1)=dersc(1)/cos(theti)**2
5496 dersc12=dersc12/cos(theti)**2
5497 escloci=-(dlog(escloc_i)-emin)
5499 dersc(j)=dersc(j)/escloc_i
5501 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5505 c----------------------------------------------------------------------------------
5506 subroutine esc(escloc)
5507 C Calculate the local energy of a side chain and its derivatives in the
5508 C corresponding virtual-bond valence angles THETA and the spherical angles
5509 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5510 C added by Urszula Kozlowska. 07/11/2007
5512 implicit real*8 (a-h,o-z)
5513 include 'DIMENSIONS'
5514 include 'COMMON.GEO'
5515 include 'COMMON.LOCAL'
5516 include 'COMMON.VAR'
5517 include 'COMMON.SCROT'
5518 include 'COMMON.INTERACT'
5519 include 'COMMON.DERIV'
5520 include 'COMMON.CHAIN'
5521 include 'COMMON.IOUNITS'
5522 include 'COMMON.NAMES'
5523 include 'COMMON.FFIELD'
5524 include 'COMMON.CONTROL'
5525 include 'COMMON.VECTORS'
5526 double precision x_prime(3),y_prime(3),z_prime(3)
5527 & , sumene,dsc_i,dp2_i,x(65),
5528 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5529 & de_dxx,de_dyy,de_dzz,de_dt
5530 double precision s1_t,s1_6_t,s2_t,s2_6_t
5532 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5533 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5534 & dt_dCi(3),dt_dCi1(3)
5535 common /sccalc/ time11,time12,time112,theti,it,nlobit
5538 do i=loc_start,loc_end
5539 costtab(i+1) =dcos(theta(i+1))
5540 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5541 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5542 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5543 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5544 cosfac=dsqrt(cosfac2)
5545 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5546 sinfac=dsqrt(sinfac2)
5548 if (it.eq.10) goto 1
5550 C Compute the axes of tghe local cartesian coordinates system; store in
5551 c x_prime, y_prime and z_prime
5558 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5559 C & dc_norm(3,i+nres)
5561 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5562 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5565 z_prime(j) = -uz(j,i-1)
5568 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5569 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5570 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5571 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5572 c & " xy",scalar(x_prime(1),y_prime(1)),
5573 c & " xz",scalar(x_prime(1),z_prime(1)),
5574 c & " yy",scalar(y_prime(1),y_prime(1)),
5575 c & " yz",scalar(y_prime(1),z_prime(1)),
5576 c & " zz",scalar(z_prime(1),z_prime(1))
5578 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5579 C to local coordinate system. Store in xx, yy, zz.
5585 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5586 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5587 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5594 C Compute the energy of the ith side cbain
5596 c write (2,*) "xx",xx," yy",yy," zz",zz
5599 x(j) = sc_parmin(j,it)
5602 Cc diagnostics - remove later
5604 yy1 = dsin(alph(2))*dcos(omeg(2))
5605 zz1 = -dsin(alph(2))*dsin(omeg(2))
5606 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5607 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5609 C," --- ", xx_w,yy_w,zz_w
5612 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5613 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5615 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5616 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5618 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5619 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5620 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5621 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5622 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5624 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5625 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5626 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5627 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5628 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5630 dsc_i = 0.743d0+x(61)
5632 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5633 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5634 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5635 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5636 s1=(1+x(63))/(0.1d0 + dscp1)
5637 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5638 s2=(1+x(65))/(0.1d0 + dscp2)
5639 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5640 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5641 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5642 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5644 c & dscp1,dscp2,sumene
5645 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5646 escloc = escloc + sumene
5647 c write (2,*) "escloc",escloc
5648 if (.not. calc_grad) goto 1
5651 C This section to check the numerical derivatives of the energy of ith side
5652 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5653 C #define DEBUG in the code to turn it on.
5655 write (2,*) "sumene =",sumene
5659 write (2,*) xx,yy,zz
5660 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5661 de_dxx_num=(sumenep-sumene)/aincr
5663 write (2,*) "xx+ sumene from enesc=",sumenep
5666 write (2,*) xx,yy,zz
5667 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5668 de_dyy_num=(sumenep-sumene)/aincr
5670 write (2,*) "yy+ sumene from enesc=",sumenep
5673 write (2,*) xx,yy,zz
5674 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5675 de_dzz_num=(sumenep-sumene)/aincr
5677 write (2,*) "zz+ sumene from enesc=",sumenep
5678 costsave=cost2tab(i+1)
5679 sintsave=sint2tab(i+1)
5680 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5681 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5682 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5683 de_dt_num=(sumenep-sumene)/aincr
5684 write (2,*) " t+ sumene from enesc=",sumenep
5685 cost2tab(i+1)=costsave
5686 sint2tab(i+1)=sintsave
5687 C End of diagnostics section.
5690 C Compute the gradient of esc
5692 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5693 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5694 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5695 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5696 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5697 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5698 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5699 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5700 pom1=(sumene3*sint2tab(i+1)+sumene1)
5701 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5702 pom2=(sumene4*cost2tab(i+1)+sumene2)
5703 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5704 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5705 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5706 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5708 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5709 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5710 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5712 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5713 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5714 & +(pom1+pom2)*pom_dx
5716 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5719 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5720 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5721 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5723 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5724 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5725 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5726 & +x(59)*zz**2 +x(60)*xx*zz
5727 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5728 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5729 & +(pom1-pom2)*pom_dy
5731 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5734 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5735 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5736 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5737 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5738 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5739 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5740 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5741 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5743 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5746 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5747 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5748 & +pom1*pom_dt1+pom2*pom_dt2
5750 write(2,*), "de_dt = ", de_dt,de_dt_num
5754 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5755 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5756 cosfac2xx=cosfac2*xx
5757 sinfac2yy=sinfac2*yy
5759 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5761 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5763 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5764 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5765 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5766 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5767 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5768 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5769 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5770 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5771 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5772 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5776 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5777 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5780 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5781 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5782 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5784 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5785 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5789 dXX_Ctab(k,i)=dXX_Ci(k)
5790 dXX_C1tab(k,i)=dXX_Ci1(k)
5791 dYY_Ctab(k,i)=dYY_Ci(k)
5792 dYY_C1tab(k,i)=dYY_Ci1(k)
5793 dZZ_Ctab(k,i)=dZZ_Ci(k)
5794 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5795 dXX_XYZtab(k,i)=dXX_XYZ(k)
5796 dYY_XYZtab(k,i)=dYY_XYZ(k)
5797 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5801 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5802 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5803 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5804 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5805 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5807 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5808 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5809 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5810 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5811 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5812 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5813 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5814 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5816 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5817 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5819 C to check gradient call subroutine check_grad
5826 c------------------------------------------------------------------------------
5827 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5829 C This procedure calculates two-body contact function g(rij) and its derivative:
5832 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5835 C where x=(rij-r0ij)/delta
5837 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5840 double precision rij,r0ij,eps0ij,fcont,fprimcont
5841 double precision x,x2,x4,delta
5845 if (x.lt.-1.0D0) then
5848 else if (x.le.1.0D0) then
5851 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5852 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5859 c------------------------------------------------------------------------------
5860 subroutine splinthet(theti,delta,ss,ssder)
5861 implicit real*8 (a-h,o-z)
5862 include 'DIMENSIONS'
5863 include 'sizesclu.dat'
5864 include 'COMMON.VAR'
5865 include 'COMMON.GEO'
5868 if (theti.gt.pipol) then
5869 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5871 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5876 c------------------------------------------------------------------------------
5877 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5879 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5880 double precision ksi,ksi2,ksi3,a1,a2,a3
5881 a1=fprim0*delta/(f1-f0)
5887 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5888 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5891 c------------------------------------------------------------------------------
5892 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5894 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5895 double precision ksi,ksi2,ksi3,a1,a2,a3
5900 a2=3*(f1x-f0x)-2*fprim0x*delta
5901 a3=fprim0x*delta-2*(f1x-f0x)
5902 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5905 C-----------------------------------------------------------------------------
5907 C-----------------------------------------------------------------------------
5908 subroutine etor(etors,edihcnstr,fact)
5909 implicit real*8 (a-h,o-z)
5910 include 'DIMENSIONS'
5911 include 'sizesclu.dat'
5912 include 'COMMON.VAR'
5913 include 'COMMON.GEO'
5914 include 'COMMON.LOCAL'
5915 include 'COMMON.TORSION'
5916 include 'COMMON.INTERACT'
5917 include 'COMMON.DERIV'
5918 include 'COMMON.CHAIN'
5919 include 'COMMON.NAMES'
5920 include 'COMMON.IOUNITS'
5921 include 'COMMON.FFIELD'
5922 include 'COMMON.TORCNSTR'
5924 C Set lprn=.true. for debugging
5928 do i=iphi_start,iphi_end
5929 itori=itortyp(itype(i-2))
5930 itori1=itortyp(itype(i-1))
5933 C Proline-Proline pair is a special case...
5934 if (itori.eq.3 .and. itori1.eq.3) then
5935 if (phii.gt.-dwapi3) then
5937 fac=1.0D0/(1.0D0-cosphi)
5938 etorsi=v1(1,3,3)*fac
5939 etorsi=etorsi+etorsi
5940 etors=etors+etorsi-v1(1,3,3)
5941 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5944 v1ij=v1(j+1,itori,itori1)
5945 v2ij=v2(j+1,itori,itori1)
5948 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5949 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5953 v1ij=v1(j,itori,itori1)
5954 v2ij=v2(j,itori,itori1)
5957 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5958 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5962 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5963 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5964 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5965 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5966 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5968 ! 6/20/98 - dihedral angle constraints
5971 itori=idih_constr(i)
5973 difi=pinorm(phii-phi0(i))
5974 if (difi.gt.drange(i)) then
5976 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5977 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5978 else if (difi.lt.-drange(i)) then
5980 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5981 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5983 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5984 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5986 write (iout,*) 'edihcnstr',edihcnstr
5989 c------------------------------------------------------------------------------
5991 subroutine etor(etors,edihcnstr,fact)
5992 implicit real*8 (a-h,o-z)
5993 include 'DIMENSIONS'
5994 include 'sizesclu.dat'
5995 include 'COMMON.VAR'
5996 include 'COMMON.GEO'
5997 include 'COMMON.LOCAL'
5998 include 'COMMON.TORSION'
5999 include 'COMMON.INTERACT'
6000 include 'COMMON.DERIV'
6001 include 'COMMON.CHAIN'
6002 include 'COMMON.NAMES'
6003 include 'COMMON.IOUNITS'
6004 include 'COMMON.FFIELD'
6005 include 'COMMON.TORCNSTR'
6007 C Set lprn=.true. for debugging
6011 do i=iphi_start,iphi_end
6012 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6013 itori=itortyp(itype(i-2))
6014 itori1=itortyp(itype(i-1))
6017 C Regular cosine and sine terms
6018 do j=1,nterm(itori,itori1)
6019 v1ij=v1(j,itori,itori1)
6020 v2ij=v2(j,itori,itori1)
6023 etors=etors+v1ij*cosphi+v2ij*sinphi
6024 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6028 C E = SUM ----------------------------------- - v1
6029 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6031 cosphi=dcos(0.5d0*phii)
6032 sinphi=dsin(0.5d0*phii)
6033 do j=1,nlor(itori,itori1)
6034 vl1ij=vlor1(j,itori,itori1)
6035 vl2ij=vlor2(j,itori,itori1)
6036 vl3ij=vlor3(j,itori,itori1)
6037 pom=vl2ij*cosphi+vl3ij*sinphi
6038 pom1=1.0d0/(pom*pom+1.0d0)
6039 etors=etors+vl1ij*pom1
6041 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6043 C Subtract the constant term
6044 etors=etors-v0(itori,itori1)
6046 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6047 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6048 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6049 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6050 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6053 ! 6/20/98 - dihedral angle constraints
6055 c write (iout,*) "Dihedral angle restraint energy"
6057 itori=idih_constr(i)
6059 difi=pinorm(phii-phi0(i))
6060 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6061 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
6062 if (difi.gt.drange(i)) then
6064 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6065 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6066 c write (iout,*) 0.25d0*ftors*difi**4
6067 else if (difi.lt.-drange(i)) then
6069 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6070 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6071 c write (iout,*) 0.25d0*ftors*difi**4
6074 c write (iout,*) 'edihcnstr',edihcnstr
6077 c----------------------------------------------------------------------------
6078 subroutine etor_d(etors_d,fact2)
6079 C 6/23/01 Compute double torsional energy
6080 implicit real*8 (a-h,o-z)
6081 include 'DIMENSIONS'
6082 include 'sizesclu.dat'
6083 include 'COMMON.VAR'
6084 include 'COMMON.GEO'
6085 include 'COMMON.LOCAL'
6086 include 'COMMON.TORSION'
6087 include 'COMMON.INTERACT'
6088 include 'COMMON.DERIV'
6089 include 'COMMON.CHAIN'
6090 include 'COMMON.NAMES'
6091 include 'COMMON.IOUNITS'
6092 include 'COMMON.FFIELD'
6093 include 'COMMON.TORCNSTR'
6095 C Set lprn=.true. for debugging
6099 do i=iphi_start,iphi_end-1
6100 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6102 itori=itortyp(itype(i-2))
6103 itori1=itortyp(itype(i-1))
6104 itori2=itortyp(itype(i))
6109 C Regular cosine and sine terms
6110 do j=1,ntermd_1(itori,itori1,itori2)
6111 v1cij=v1c(1,j,itori,itori1,itori2)
6112 v1sij=v1s(1,j,itori,itori1,itori2)
6113 v2cij=v1c(2,j,itori,itori1,itori2)
6114 v2sij=v1s(2,j,itori,itori1,itori2)
6115 cosphi1=dcos(j*phii)
6116 sinphi1=dsin(j*phii)
6117 cosphi2=dcos(j*phii1)
6118 sinphi2=dsin(j*phii1)
6119 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6120 & v2cij*cosphi2+v2sij*sinphi2
6121 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6122 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6124 do k=2,ntermd_2(itori,itori1,itori2)
6126 v1cdij = v2c(k,l,itori,itori1,itori2)
6127 v2cdij = v2c(l,k,itori,itori1,itori2)
6128 v1sdij = v2s(k,l,itori,itori1,itori2)
6129 v2sdij = v2s(l,k,itori,itori1,itori2)
6130 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6131 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6132 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6133 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6134 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6135 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6136 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6137 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6138 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6139 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6142 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6143 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6149 c------------------------------------------------------------------------------
6150 subroutine eback_sc_corr(esccor,fact)
6151 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6152 c conformational states; temporarily implemented as differences
6153 c between UNRES torsional potentials (dependent on three types of
6154 c residues) and the torsional potentials dependent on all 20 types
6155 c of residues computed from AM1 energy surfaces of terminally-blocked
6156 c amino-acid residues.
6157 implicit real*8 (a-h,o-z)
6158 include 'DIMENSIONS'
6159 include 'COMMON.VAR'
6160 include 'COMMON.GEO'
6161 include 'COMMON.LOCAL'
6162 include 'COMMON.TORSION'
6163 include 'COMMON.SCCOR'
6164 include 'COMMON.INTERACT'
6165 include 'COMMON.DERIV'
6166 include 'COMMON.CHAIN'
6167 include 'COMMON.NAMES'
6168 include 'COMMON.IOUNITS'
6169 include 'COMMON.FFIELD'
6170 include 'COMMON.CONTROL'
6172 C Set lprn=.true. for debugging
6175 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6177 do i=itau_start,itau_end
6179 isccori=isccortyp(itype(i-2))
6180 isccori1=isccortyp(itype(i-1))
6182 cccc Added 9 May 2012
6183 cc Tauangle is torsional engle depending on the value of first digit
6184 c(see comment below)
6185 cc Omicron is flat angle depending on the value of first digit
6186 c(see comment below)
6189 do intertyp=1,3 !intertyp
6190 cc Added 09 May 2012 (Adasko)
6191 cc Intertyp means interaction type of backbone mainchain correlation:
6192 c 1 = SC...Ca...Ca...Ca
6193 c 2 = Ca...Ca...Ca...SC
6194 c 3 = SC...Ca...Ca...SCi
6196 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6197 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6198 & (itype(i-1).eq.21)))
6199 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6200 & .or.(itype(i-2).eq.21)))
6201 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6202 & (itype(i-1).eq.21)))) cycle
6203 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6204 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6206 do j=1,nterm_sccor(isccori,isccori1)
6207 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6208 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6209 cosphi=dcos(j*tauangle(intertyp,i))
6210 sinphi=dsin(j*tauangle(intertyp,i))
6211 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6212 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6214 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6215 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6216 c &gloc_sc(intertyp,i-3,icg)
6218 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6219 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6220 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6221 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6222 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6228 c------------------------------------------------------------------------------
6229 subroutine multibody(ecorr)
6230 C This subroutine calculates multi-body contributions to energy following
6231 C the idea of Skolnick et al. If side chains I and J make a contact and
6232 C at the same time side chains I+1 and J+1 make a contact, an extra
6233 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6234 implicit real*8 (a-h,o-z)
6235 include 'DIMENSIONS'
6236 include 'COMMON.IOUNITS'
6237 include 'COMMON.DERIV'
6238 include 'COMMON.INTERACT'
6239 include 'COMMON.CONTACTS'
6240 double precision gx(3),gx1(3)
6243 C Set lprn=.true. for debugging
6247 write (iout,'(a)') 'Contact function values:'
6249 write (iout,'(i2,20(1x,i2,f10.5))')
6250 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6265 num_conti=num_cont(i)
6266 num_conti1=num_cont(i1)
6271 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6272 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6273 cd & ' ishift=',ishift
6274 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6275 C The system gains extra energy.
6276 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6277 endif ! j1==j+-ishift
6286 c------------------------------------------------------------------------------
6287 double precision function esccorr(i,j,k,l,jj,kk)
6288 implicit real*8 (a-h,o-z)
6289 include 'DIMENSIONS'
6290 include 'COMMON.IOUNITS'
6291 include 'COMMON.DERIV'
6292 include 'COMMON.INTERACT'
6293 include 'COMMON.CONTACTS'
6294 double precision gx(3),gx1(3)
6299 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6300 C Calculate the multi-body contribution to energy.
6301 C Calculate multi-body contributions to the gradient.
6302 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6303 cd & k,l,(gacont(m,kk,k),m=1,3)
6305 gx(m) =ekl*gacont(m,jj,i)
6306 gx1(m)=eij*gacont(m,kk,k)
6307 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6308 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6309 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6310 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6314 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6319 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6325 c------------------------------------------------------------------------------
6327 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
6328 implicit real*8 (a-h,o-z)
6329 include 'DIMENSIONS'
6330 integer dimen1,dimen2,atom,indx
6331 double precision buffer(dimen1,dimen2)
6332 double precision zapas
6333 common /contacts_hb/ zapas(3,20,maxres,7),
6334 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6335 & num_cont_hb(maxres),jcont_hb(20,maxres)
6336 num_kont=num_cont_hb(atom)
6340 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
6343 buffer(i,indx+22)=facont_hb(i,atom)
6344 buffer(i,indx+23)=ees0p(i,atom)
6345 buffer(i,indx+24)=ees0m(i,atom)
6346 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
6348 buffer(1,indx+26)=dfloat(num_kont)
6351 c------------------------------------------------------------------------------
6352 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
6353 implicit real*8 (a-h,o-z)
6354 include 'DIMENSIONS'
6355 integer dimen1,dimen2,atom,indx
6356 double precision buffer(dimen1,dimen2)
6357 double precision zapas
6358 common /contacts_hb/ zapas(3,20,maxres,7),
6359 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6360 & num_cont_hb(maxres),jcont_hb(20,maxres)
6361 num_kont=buffer(1,indx+26)
6362 num_kont_old=num_cont_hb(atom)
6363 num_cont_hb(atom)=num_kont+num_kont_old
6368 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
6371 facont_hb(ii,atom)=buffer(i,indx+22)
6372 ees0p(ii,atom)=buffer(i,indx+23)
6373 ees0m(ii,atom)=buffer(i,indx+24)
6374 jcont_hb(ii,atom)=buffer(i,indx+25)
6378 c------------------------------------------------------------------------------
6380 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6381 C This subroutine calculates multi-body contributions to hydrogen-bonding
6382 implicit real*8 (a-h,o-z)
6383 include 'DIMENSIONS'
6384 include 'sizesclu.dat'
6385 include 'COMMON.IOUNITS'
6387 include 'COMMON.INFO'
6389 include 'COMMON.FFIELD'
6390 include 'COMMON.DERIV'
6391 include 'COMMON.INTERACT'
6392 include 'COMMON.CONTACTS'
6394 parameter (max_cont=maxconts)
6395 parameter (max_dim=2*(8*3+2))
6396 parameter (msglen1=max_cont*max_dim*4)
6397 parameter (msglen2=2*msglen1)
6398 integer source,CorrelType,CorrelID,Error
6399 double precision buffer(max_cont,max_dim)
6401 double precision gx(3),gx1(3)
6404 C Set lprn=.true. for debugging
6409 if (fgProcs.le.1) goto 30
6411 write (iout,'(a)') 'Contact function values:'
6413 write (iout,'(2i3,50(1x,i2,f5.2))')
6414 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6415 & j=1,num_cont_hb(i))
6418 C Caution! Following code assumes that electrostatic interactions concerning
6419 C a given atom are split among at most two processors!
6429 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6432 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6433 if (MyRank.gt.0) then
6434 C Send correlation contributions to the preceding processor
6436 nn=num_cont_hb(iatel_s)
6437 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6438 cd write (iout,*) 'The BUFFER array:'
6440 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6442 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6444 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6445 C Clear the contacts of the atom passed to the neighboring processor
6446 nn=num_cont_hb(iatel_s+1)
6448 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6450 num_cont_hb(iatel_s)=0
6452 cd write (iout,*) 'Processor ',MyID,MyRank,
6453 cd & ' is sending correlation contribution to processor',MyID-1,
6454 cd & ' msglen=',msglen
6455 cd write (*,*) 'Processor ',MyID,MyRank,
6456 cd & ' is sending correlation contribution to processor',MyID-1,
6457 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6458 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6459 cd write (iout,*) 'Processor ',MyID,
6460 cd & ' has sent correlation contribution to processor',MyID-1,
6461 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6462 cd write (*,*) 'Processor ',MyID,
6463 cd & ' has sent correlation contribution to processor',MyID-1,
6464 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6466 endif ! (MyRank.gt.0)
6470 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6471 if (MyRank.lt.fgProcs-1) then
6472 C Receive correlation contributions from the next processor
6474 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6475 cd write (iout,*) 'Processor',MyID,
6476 cd & ' is receiving correlation contribution from processor',MyID+1,
6477 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6478 cd write (*,*) 'Processor',MyID,
6479 cd & ' is receiving correlation contribution from processor',MyID+1,
6480 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6482 do while (nbytes.le.0)
6483 call mp_probe(MyID+1,CorrelType,nbytes)
6485 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6486 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6487 cd write (iout,*) 'Processor',MyID,
6488 cd & ' has received correlation contribution from processor',MyID+1,
6489 cd & ' msglen=',msglen,' nbytes=',nbytes
6490 cd write (iout,*) 'The received BUFFER array:'
6492 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6494 if (msglen.eq.msglen1) then
6495 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6496 else if (msglen.eq.msglen2) then
6497 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6498 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6501 & 'ERROR!!!! message length changed while processing correlations.'
6503 & 'ERROR!!!! message length changed while processing correlations.'
6504 call mp_stopall(Error)
6505 endif ! msglen.eq.msglen1
6506 endif ! MyRank.lt.fgProcs-1
6513 write (iout,'(a)') 'Contact function values:'
6515 write (iout,'(2i3,50(1x,i2,f5.2))')
6516 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6517 & j=1,num_cont_hb(i))
6521 C Remove the loop below after debugging !!!
6528 C Calculate the local-electrostatic correlation terms
6529 do i=iatel_s,iatel_e+1
6531 num_conti=num_cont_hb(i)
6532 num_conti1=num_cont_hb(i+1)
6537 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6538 c & ' jj=',jj,' kk=',kk
6539 if (j1.eq.j+1 .or. j1.eq.j-1) then
6540 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6541 C The system gains extra energy.
6542 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6544 else if (j1.eq.j) then
6545 C Contacts I-J and I-(J+1) occur simultaneously.
6546 C The system loses extra energy.
6547 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6552 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6553 c & ' jj=',jj,' kk=',kk
6555 C Contacts I-J and (I+1)-J occur simultaneously.
6556 C The system loses extra energy.
6557 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6564 c------------------------------------------------------------------------------
6565 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6567 C This subroutine calculates multi-body contributions to hydrogen-bonding
6568 implicit real*8 (a-h,o-z)
6569 include 'DIMENSIONS'
6570 include 'sizesclu.dat'
6571 include 'COMMON.IOUNITS'
6573 include 'COMMON.INFO'
6575 include 'COMMON.FFIELD'
6576 include 'COMMON.DERIV'
6577 include 'COMMON.INTERACT'
6578 include 'COMMON.CONTACTS'
6580 parameter (max_cont=maxconts)
6581 parameter (max_dim=2*(8*3+2))
6582 parameter (msglen1=max_cont*max_dim*4)
6583 parameter (msglen2=2*msglen1)
6584 integer source,CorrelType,CorrelID,Error
6585 double precision buffer(max_cont,max_dim)
6587 double precision gx(3),gx1(3)
6590 C Set lprn=.true. for debugging
6596 if (fgProcs.le.1) goto 30
6598 write (iout,'(a)') 'Contact function values:'
6600 write (iout,'(2i3,50(1x,i2,f5.2))')
6601 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6602 & j=1,num_cont_hb(i))
6605 C Caution! Following code assumes that electrostatic interactions concerning
6606 C a given atom are split among at most two processors!
6616 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6619 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6620 if (MyRank.gt.0) then
6621 C Send correlation contributions to the preceding processor
6623 nn=num_cont_hb(iatel_s)
6624 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6625 cd write (iout,*) 'The BUFFER array:'
6627 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6629 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6631 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6632 C Clear the contacts of the atom passed to the neighboring processor
6633 nn=num_cont_hb(iatel_s+1)
6635 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6637 num_cont_hb(iatel_s)=0
6639 cd write (iout,*) 'Processor ',MyID,MyRank,
6640 cd & ' is sending correlation contribution to processor',MyID-1,
6641 cd & ' msglen=',msglen
6642 cd write (*,*) 'Processor ',MyID,MyRank,
6643 cd & ' is sending correlation contribution to processor',MyID-1,
6644 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6645 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6646 cd write (iout,*) 'Processor ',MyID,
6647 cd & ' has sent correlation contribution to processor',MyID-1,
6648 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6649 cd write (*,*) 'Processor ',MyID,
6650 cd & ' has sent correlation contribution to processor',MyID-1,
6651 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6653 endif ! (MyRank.gt.0)
6657 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6658 if (MyRank.lt.fgProcs-1) then
6659 C Receive correlation contributions from the next processor
6661 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6662 cd write (iout,*) 'Processor',MyID,
6663 cd & ' is receiving correlation contribution from processor',MyID+1,
6664 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6665 cd write (*,*) 'Processor',MyID,
6666 cd & ' is receiving correlation contribution from processor',MyID+1,
6667 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6669 do while (nbytes.le.0)
6670 call mp_probe(MyID+1,CorrelType,nbytes)
6672 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6673 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6674 cd write (iout,*) 'Processor',MyID,
6675 cd & ' has received correlation contribution from processor',MyID+1,
6676 cd & ' msglen=',msglen,' nbytes=',nbytes
6677 cd write (iout,*) 'The received BUFFER array:'
6679 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6681 if (msglen.eq.msglen1) then
6682 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6683 else if (msglen.eq.msglen2) then
6684 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6685 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6688 & 'ERROR!!!! message length changed while processing correlations.'
6690 & 'ERROR!!!! message length changed while processing correlations.'
6691 call mp_stopall(Error)
6692 endif ! msglen.eq.msglen1
6693 endif ! MyRank.lt.fgProcs-1
6700 write (iout,'(a)') 'Contact function values:'
6702 write (iout,'(2i3,50(1x,i2,f5.2))')
6703 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6704 & j=1,num_cont_hb(i))
6710 C Remove the loop below after debugging !!!
6717 C Calculate the dipole-dipole interaction energies
6718 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6719 do i=iatel_s,iatel_e+1
6720 num_conti=num_cont_hb(i)
6727 C Calculate the local-electrostatic correlation terms
6728 do i=iatel_s,iatel_e+1
6730 num_conti=num_cont_hb(i)
6731 num_conti1=num_cont_hb(i+1)
6736 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6737 c & ' jj=',jj,' kk=',kk
6738 if (j1.eq.j+1 .or. j1.eq.j-1) then
6739 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6740 C The system gains extra energy.
6742 sqd1=dsqrt(d_cont(jj,i))
6743 sqd2=dsqrt(d_cont(kk,i1))
6744 sred_geom = sqd1*sqd2
6745 IF (sred_geom.lt.cutoff_corr) THEN
6746 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6748 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6749 c & ' jj=',jj,' kk=',kk
6750 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6751 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6753 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6754 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6757 cd write (iout,*) 'sred_geom=',sred_geom,
6758 cd & ' ekont=',ekont,' fprim=',fprimcont
6759 call calc_eello(i,j,i+1,j1,jj,kk)
6760 if (wcorr4.gt.0.0d0)
6761 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6762 if (wcorr5.gt.0.0d0)
6763 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6764 c print *,"wcorr5",ecorr5
6765 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6766 cd write(2,*)'ijkl',i,j,i+1,j1
6767 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6768 & .or. wturn6.eq.0.0d0))then
6769 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6770 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6771 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6772 cd & 'ecorr6=',ecorr6
6773 cd write (iout,'(4e15.5)') sred_geom,
6774 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6775 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6776 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6777 else if (wturn6.gt.0.0d0
6778 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6779 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6780 eturn6=eturn6+eello_turn6(i,jj,kk)
6781 cd write (2,*) 'multibody_eello:eturn6',eturn6
6785 else if (j1.eq.j) then
6786 C Contacts I-J and I-(J+1) occur simultaneously.
6787 C The system loses extra energy.
6788 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6793 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6794 c & ' jj=',jj,' kk=',kk
6796 C Contacts I-J and (I+1)-J occur simultaneously.
6797 C The system loses extra energy.
6798 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6805 c------------------------------------------------------------------------------
6806 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6807 implicit real*8 (a-h,o-z)
6808 include 'DIMENSIONS'
6809 include 'COMMON.IOUNITS'
6810 include 'COMMON.DERIV'
6811 include 'COMMON.INTERACT'
6812 include 'COMMON.CONTACTS'
6813 double precision gx(3),gx1(3)
6823 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6824 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6825 C Following 4 lines for diagnostics.
6830 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6832 c write (iout,*)'Contacts have occurred for peptide groups',
6833 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6834 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6835 C Calculate the multi-body contribution to energy.
6836 ecorr=ecorr+ekont*ees
6838 C Calculate multi-body contributions to the gradient.
6840 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6841 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6842 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6843 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6844 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6845 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6846 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6847 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6848 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6849 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6850 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6851 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6852 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6853 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6857 gradcorr(ll,m)=gradcorr(ll,m)+
6858 & ees*ekl*gacont_hbr(ll,jj,i)-
6859 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6860 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6865 gradcorr(ll,m)=gradcorr(ll,m)+
6866 & ees*eij*gacont_hbr(ll,kk,k)-
6867 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6868 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6875 C---------------------------------------------------------------------------
6876 subroutine dipole(i,j,jj)
6877 implicit real*8 (a-h,o-z)
6878 include 'DIMENSIONS'
6879 include 'sizesclu.dat'
6880 include 'COMMON.IOUNITS'
6881 include 'COMMON.CHAIN'
6882 include 'COMMON.FFIELD'
6883 include 'COMMON.DERIV'
6884 include 'COMMON.INTERACT'
6885 include 'COMMON.CONTACTS'
6886 include 'COMMON.TORSION'
6887 include 'COMMON.VAR'
6888 include 'COMMON.GEO'
6889 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6891 iti1 = itortyp(itype(i+1))
6892 if (j.lt.nres-1) then
6893 itj1 = itortyp(itype(j+1))
6898 dipi(iii,1)=Ub2(iii,i)
6899 dipderi(iii)=Ub2der(iii,i)
6900 dipi(iii,2)=b1(iii,iti1)
6901 dipj(iii,1)=Ub2(iii,j)
6902 dipderj(iii)=Ub2der(iii,j)
6903 dipj(iii,2)=b1(iii,itj1)
6907 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6910 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6913 if (.not.calc_grad) return
6918 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6922 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6927 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6928 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6930 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6932 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6934 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6938 C---------------------------------------------------------------------------
6939 subroutine calc_eello(i,j,k,l,jj,kk)
6941 C This subroutine computes matrices and vectors needed to calculate
6942 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6944 implicit real*8 (a-h,o-z)
6945 include 'DIMENSIONS'
6946 include 'sizesclu.dat'
6947 include 'COMMON.IOUNITS'
6948 include 'COMMON.CHAIN'
6949 include 'COMMON.DERIV'
6950 include 'COMMON.INTERACT'
6951 include 'COMMON.CONTACTS'
6952 include 'COMMON.TORSION'
6953 include 'COMMON.VAR'
6954 include 'COMMON.GEO'
6955 include 'COMMON.FFIELD'
6956 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6957 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6960 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6961 cd & ' jj=',jj,' kk=',kk
6962 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6965 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6966 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6969 call transpose2(aa1(1,1),aa1t(1,1))
6970 call transpose2(aa2(1,1),aa2t(1,1))
6973 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6974 & aa1tder(1,1,lll,kkk))
6975 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6976 & aa2tder(1,1,lll,kkk))
6980 C parallel orientation of the two CA-CA-CA frames.
6982 iti=itortyp(itype(i))
6986 itk1=itortyp(itype(k+1))
6987 itj=itortyp(itype(j))
6988 if (l.lt.nres-1) then
6989 itl1=itortyp(itype(l+1))
6993 C A1 kernel(j+1) A2T
6995 cd write (iout,'(3f10.5,5x,3f10.5)')
6996 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6998 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6999 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7000 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7001 C Following matrices are needed only for 6-th order cumulants
7002 IF (wcorr6.gt.0.0d0) THEN
7003 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7004 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7005 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7006 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7007 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7008 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7009 & ADtEAderx(1,1,1,1,1,1))
7011 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7012 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7013 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7014 & ADtEA1derx(1,1,1,1,1,1))
7016 C End 6-th order cumulants
7019 cd write (2,*) 'In calc_eello6'
7021 cd write (2,*) 'iii=',iii
7023 cd write (2,*) 'kkk=',kkk
7025 cd write (2,'(3(2f10.5),5x)')
7026 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7031 call transpose2(EUgder(1,1,k),auxmat(1,1))
7032 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7033 call transpose2(EUg(1,1,k),auxmat(1,1))
7034 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7035 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7039 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7040 & EAEAderx(1,1,lll,kkk,iii,1))
7044 C A1T kernel(i+1) A2
7045 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7046 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7047 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7048 C Following matrices are needed only for 6-th order cumulants
7049 IF (wcorr6.gt.0.0d0) THEN
7050 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7051 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7052 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7053 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7054 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7055 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7056 & ADtEAderx(1,1,1,1,1,2))
7057 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7058 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7059 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7060 & ADtEA1derx(1,1,1,1,1,2))
7062 C End 6-th order cumulants
7063 call transpose2(EUgder(1,1,l),auxmat(1,1))
7064 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7065 call transpose2(EUg(1,1,l),auxmat(1,1))
7066 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7067 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7071 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7072 & EAEAderx(1,1,lll,kkk,iii,2))
7077 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7078 C They are needed only when the fifth- or the sixth-order cumulants are
7080 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7081 call transpose2(AEA(1,1,1),auxmat(1,1))
7082 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7083 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7084 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7085 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7086 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7087 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7088 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7089 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7090 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7091 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7092 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7093 call transpose2(AEA(1,1,2),auxmat(1,1))
7094 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7095 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7096 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7097 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7098 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7099 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7100 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7101 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7102 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7103 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7104 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7105 C Calculate the Cartesian derivatives of the vectors.
7109 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7110 call matvec2(auxmat(1,1),b1(1,iti),
7111 & AEAb1derx(1,lll,kkk,iii,1,1))
7112 call matvec2(auxmat(1,1),Ub2(1,i),
7113 & AEAb2derx(1,lll,kkk,iii,1,1))
7114 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7115 & AEAb1derx(1,lll,kkk,iii,2,1))
7116 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7117 & AEAb2derx(1,lll,kkk,iii,2,1))
7118 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7119 call matvec2(auxmat(1,1),b1(1,itj),
7120 & AEAb1derx(1,lll,kkk,iii,1,2))
7121 call matvec2(auxmat(1,1),Ub2(1,j),
7122 & AEAb2derx(1,lll,kkk,iii,1,2))
7123 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7124 & AEAb1derx(1,lll,kkk,iii,2,2))
7125 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7126 & AEAb2derx(1,lll,kkk,iii,2,2))
7133 C Antiparallel orientation of the two CA-CA-CA frames.
7135 iti=itortyp(itype(i))
7139 itk1=itortyp(itype(k+1))
7140 itl=itortyp(itype(l))
7141 itj=itortyp(itype(j))
7142 if (j.lt.nres-1) then
7143 itj1=itortyp(itype(j+1))
7147 C A2 kernel(j-1)T A1T
7148 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7149 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7150 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7151 C Following matrices are needed only for 6-th order cumulants
7152 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7153 & j.eq.i+4 .and. l.eq.i+3)) THEN
7154 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7155 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7156 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7157 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7158 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7159 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7160 & ADtEAderx(1,1,1,1,1,1))
7161 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7162 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7163 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7164 & ADtEA1derx(1,1,1,1,1,1))
7166 C End 6-th order cumulants
7167 call transpose2(EUgder(1,1,k),auxmat(1,1))
7168 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7169 call transpose2(EUg(1,1,k),auxmat(1,1))
7170 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7171 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7175 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7176 & EAEAderx(1,1,lll,kkk,iii,1))
7180 C A2T kernel(i+1)T A1
7181 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7182 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7183 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7184 C Following matrices are needed only for 6-th order cumulants
7185 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7186 & j.eq.i+4 .and. l.eq.i+3)) THEN
7187 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7188 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7189 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7190 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7191 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7192 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7193 & ADtEAderx(1,1,1,1,1,2))
7194 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7195 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7196 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7197 & ADtEA1derx(1,1,1,1,1,2))
7199 C End 6-th order cumulants
7200 call transpose2(EUgder(1,1,j),auxmat(1,1))
7201 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7202 call transpose2(EUg(1,1,j),auxmat(1,1))
7203 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7204 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7208 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7209 & EAEAderx(1,1,lll,kkk,iii,2))
7214 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7215 C They are needed only when the fifth- or the sixth-order cumulants are
7217 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7218 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7219 call transpose2(AEA(1,1,1),auxmat(1,1))
7220 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7221 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7222 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7223 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7224 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7225 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7226 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7227 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7228 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7229 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7230 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7231 call transpose2(AEA(1,1,2),auxmat(1,1))
7232 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7233 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7234 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7235 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7236 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7237 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7238 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7239 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7240 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7241 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7242 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7243 C Calculate the Cartesian derivatives of the vectors.
7247 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7248 call matvec2(auxmat(1,1),b1(1,iti),
7249 & AEAb1derx(1,lll,kkk,iii,1,1))
7250 call matvec2(auxmat(1,1),Ub2(1,i),
7251 & AEAb2derx(1,lll,kkk,iii,1,1))
7252 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7253 & AEAb1derx(1,lll,kkk,iii,2,1))
7254 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7255 & AEAb2derx(1,lll,kkk,iii,2,1))
7256 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7257 call matvec2(auxmat(1,1),b1(1,itl),
7258 & AEAb1derx(1,lll,kkk,iii,1,2))
7259 call matvec2(auxmat(1,1),Ub2(1,l),
7260 & AEAb2derx(1,lll,kkk,iii,1,2))
7261 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7262 & AEAb1derx(1,lll,kkk,iii,2,2))
7263 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7264 & AEAb2derx(1,lll,kkk,iii,2,2))
7273 C---------------------------------------------------------------------------
7274 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7275 & KK,KKderg,AKA,AKAderg,AKAderx)
7279 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7280 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7281 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7286 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7288 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7291 cd if (lprn) write (2,*) 'In kernel'
7293 cd if (lprn) write (2,*) 'kkk=',kkk
7295 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7296 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7298 cd write (2,*) 'lll=',lll
7299 cd write (2,*) 'iii=1'
7301 cd write (2,'(3(2f10.5),5x)')
7302 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7305 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7306 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7308 cd write (2,*) 'lll=',lll
7309 cd write (2,*) 'iii=2'
7311 cd write (2,'(3(2f10.5),5x)')
7312 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7319 C---------------------------------------------------------------------------
7320 double precision function eello4(i,j,k,l,jj,kk)
7321 implicit real*8 (a-h,o-z)
7322 include 'DIMENSIONS'
7323 include 'sizesclu.dat'
7324 include 'COMMON.IOUNITS'
7325 include 'COMMON.CHAIN'
7326 include 'COMMON.DERIV'
7327 include 'COMMON.INTERACT'
7328 include 'COMMON.CONTACTS'
7329 include 'COMMON.TORSION'
7330 include 'COMMON.VAR'
7331 include 'COMMON.GEO'
7332 double precision pizda(2,2),ggg1(3),ggg2(3)
7333 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7337 cd print *,'eello4:',i,j,k,l,jj,kk
7338 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7339 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7340 cold eij=facont_hb(jj,i)
7341 cold ekl=facont_hb(kk,k)
7343 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7345 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7346 gcorr_loc(k-1)=gcorr_loc(k-1)
7347 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7349 gcorr_loc(l-1)=gcorr_loc(l-1)
7350 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7352 gcorr_loc(j-1)=gcorr_loc(j-1)
7353 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7358 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7359 & -EAEAderx(2,2,lll,kkk,iii,1)
7360 cd derx(lll,kkk,iii)=0.0d0
7364 cd gcorr_loc(l-1)=0.0d0
7365 cd gcorr_loc(j-1)=0.0d0
7366 cd gcorr_loc(k-1)=0.0d0
7368 cd write (iout,*)'Contacts have occurred for peptide groups',
7369 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7370 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7371 if (j.lt.nres-1) then
7378 if (l.lt.nres-1) then
7386 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
7387 ggg1(ll)=eel4*g_contij(ll,1)
7388 ggg2(ll)=eel4*g_contij(ll,2)
7389 ghalf=0.5d0*ggg1(ll)
7391 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
7392 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7393 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
7394 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7395 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
7396 ghalf=0.5d0*ggg2(ll)
7398 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
7399 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7400 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
7401 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7406 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
7407 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7412 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
7413 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7419 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7424 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7428 cd write (2,*) iii,gcorr_loc(iii)
7432 cd write (2,*) 'ekont',ekont
7433 cd write (iout,*) 'eello4',ekont*eel4
7436 C---------------------------------------------------------------------------
7437 double precision function eello5(i,j,k,l,jj,kk)
7438 implicit real*8 (a-h,o-z)
7439 include 'DIMENSIONS'
7440 include 'sizesclu.dat'
7441 include 'COMMON.IOUNITS'
7442 include 'COMMON.CHAIN'
7443 include 'COMMON.DERIV'
7444 include 'COMMON.INTERACT'
7445 include 'COMMON.CONTACTS'
7446 include 'COMMON.TORSION'
7447 include 'COMMON.VAR'
7448 include 'COMMON.GEO'
7449 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7450 double precision ggg1(3),ggg2(3)
7451 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7456 C /l\ / \ \ / \ / \ / C
7457 C / \ / \ \ / \ / \ / C
7458 C j| o |l1 | o | o| o | | o |o C
7459 C \ |/k\| |/ \| / |/ \| |/ \| C
7460 C \i/ \ / \ / / \ / \ C
7462 C (I) (II) (III) (IV) C
7464 C eello5_1 eello5_2 eello5_3 eello5_4 C
7466 C Antiparallel chains C
7469 C /j\ / \ \ / \ / \ / C
7470 C / \ / \ \ / \ / \ / C
7471 C j1| o |l | o | o| o | | o |o C
7472 C \ |/k\| |/ \| / |/ \| |/ \| C
7473 C \i/ \ / \ / / \ / \ C
7475 C (I) (II) (III) (IV) C
7477 C eello5_1 eello5_2 eello5_3 eello5_4 C
7479 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7481 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7482 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7487 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7489 itk=itortyp(itype(k))
7490 itl=itortyp(itype(l))
7491 itj=itortyp(itype(j))
7496 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7497 cd & eel5_3_num,eel5_4_num)
7501 derx(lll,kkk,iii)=0.0d0
7505 cd eij=facont_hb(jj,i)
7506 cd ekl=facont_hb(kk,k)
7508 cd write (iout,*)'Contacts have occurred for peptide groups',
7509 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7511 C Contribution from the graph I.
7512 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7513 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7514 call transpose2(EUg(1,1,k),auxmat(1,1))
7515 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7516 vv(1)=pizda(1,1)-pizda(2,2)
7517 vv(2)=pizda(1,2)+pizda(2,1)
7518 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7519 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7521 C Explicit gradient in virtual-dihedral angles.
7522 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7523 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7524 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7525 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7526 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7527 vv(1)=pizda(1,1)-pizda(2,2)
7528 vv(2)=pizda(1,2)+pizda(2,1)
7529 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7530 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7531 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7532 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7533 vv(1)=pizda(1,1)-pizda(2,2)
7534 vv(2)=pizda(1,2)+pizda(2,1)
7536 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7537 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7538 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7540 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7541 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7542 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7544 C Cartesian gradient
7548 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7550 vv(1)=pizda(1,1)-pizda(2,2)
7551 vv(2)=pizda(1,2)+pizda(2,1)
7552 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7553 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7554 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7561 C Contribution from graph II
7562 call transpose2(EE(1,1,itk),auxmat(1,1))
7563 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7564 vv(1)=pizda(1,1)+pizda(2,2)
7565 vv(2)=pizda(2,1)-pizda(1,2)
7566 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7567 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7569 C Explicit gradient in virtual-dihedral angles.
7570 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7571 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7572 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7573 vv(1)=pizda(1,1)+pizda(2,2)
7574 vv(2)=pizda(2,1)-pizda(1,2)
7576 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7577 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7578 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7580 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7581 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7582 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7584 C Cartesian gradient
7588 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7590 vv(1)=pizda(1,1)+pizda(2,2)
7591 vv(2)=pizda(2,1)-pizda(1,2)
7592 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7593 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7594 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7603 C Parallel orientation
7604 C Contribution from graph III
7605 call transpose2(EUg(1,1,l),auxmat(1,1))
7606 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7607 vv(1)=pizda(1,1)-pizda(2,2)
7608 vv(2)=pizda(1,2)+pizda(2,1)
7609 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7610 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7612 C Explicit gradient in virtual-dihedral angles.
7613 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7614 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7615 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7616 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7617 vv(1)=pizda(1,1)-pizda(2,2)
7618 vv(2)=pizda(1,2)+pizda(2,1)
7619 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7620 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7621 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7622 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7623 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7624 vv(1)=pizda(1,1)-pizda(2,2)
7625 vv(2)=pizda(1,2)+pizda(2,1)
7626 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7627 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7628 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7629 C Cartesian gradient
7633 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7635 vv(1)=pizda(1,1)-pizda(2,2)
7636 vv(2)=pizda(1,2)+pizda(2,1)
7637 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7638 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7639 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7645 C Contribution from graph IV
7647 call transpose2(EE(1,1,itl),auxmat(1,1))
7648 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7649 vv(1)=pizda(1,1)+pizda(2,2)
7650 vv(2)=pizda(2,1)-pizda(1,2)
7651 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7652 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7654 C Explicit gradient in virtual-dihedral angles.
7655 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7656 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7657 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7658 vv(1)=pizda(1,1)+pizda(2,2)
7659 vv(2)=pizda(2,1)-pizda(1,2)
7660 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7661 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7662 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7663 C Cartesian gradient
7667 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7669 vv(1)=pizda(1,1)+pizda(2,2)
7670 vv(2)=pizda(2,1)-pizda(1,2)
7671 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7672 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7673 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7679 C Antiparallel orientation
7680 C Contribution from graph III
7682 call transpose2(EUg(1,1,j),auxmat(1,1))
7683 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7684 vv(1)=pizda(1,1)-pizda(2,2)
7685 vv(2)=pizda(1,2)+pizda(2,1)
7686 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7687 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7689 C Explicit gradient in virtual-dihedral angles.
7690 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7691 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7692 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7693 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7694 vv(1)=pizda(1,1)-pizda(2,2)
7695 vv(2)=pizda(1,2)+pizda(2,1)
7696 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7697 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7698 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7699 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7700 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7701 vv(1)=pizda(1,1)-pizda(2,2)
7702 vv(2)=pizda(1,2)+pizda(2,1)
7703 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7704 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7705 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7706 C Cartesian gradient
7710 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7712 vv(1)=pizda(1,1)-pizda(2,2)
7713 vv(2)=pizda(1,2)+pizda(2,1)
7714 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7715 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7716 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7722 C Contribution from graph IV
7724 call transpose2(EE(1,1,itj),auxmat(1,1))
7725 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7726 vv(1)=pizda(1,1)+pizda(2,2)
7727 vv(2)=pizda(2,1)-pizda(1,2)
7728 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7729 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7731 C Explicit gradient in virtual-dihedral angles.
7732 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7733 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7734 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7735 vv(1)=pizda(1,1)+pizda(2,2)
7736 vv(2)=pizda(2,1)-pizda(1,2)
7737 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7738 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7739 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7740 C Cartesian gradient
7744 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7746 vv(1)=pizda(1,1)+pizda(2,2)
7747 vv(2)=pizda(2,1)-pizda(1,2)
7748 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7749 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7750 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7757 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7758 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7759 cd write (2,*) 'ijkl',i,j,k,l
7760 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7761 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7763 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7764 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7765 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7766 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7768 if (j.lt.nres-1) then
7775 if (l.lt.nres-1) then
7785 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7787 ggg1(ll)=eel5*g_contij(ll,1)
7788 ggg2(ll)=eel5*g_contij(ll,2)
7789 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7790 ghalf=0.5d0*ggg1(ll)
7792 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7793 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7794 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7795 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7796 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7797 ghalf=0.5d0*ggg2(ll)
7799 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7800 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7801 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7802 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7807 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7808 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7813 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7814 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7820 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7825 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7829 cd write (2,*) iii,g_corr5_loc(iii)
7833 cd write (2,*) 'ekont',ekont
7834 cd write (iout,*) 'eello5',ekont*eel5
7837 c--------------------------------------------------------------------------
7838 double precision function eello6(i,j,k,l,jj,kk)
7839 implicit real*8 (a-h,o-z)
7840 include 'DIMENSIONS'
7841 include 'sizesclu.dat'
7842 include 'COMMON.IOUNITS'
7843 include 'COMMON.CHAIN'
7844 include 'COMMON.DERIV'
7845 include 'COMMON.INTERACT'
7846 include 'COMMON.CONTACTS'
7847 include 'COMMON.TORSION'
7848 include 'COMMON.VAR'
7849 include 'COMMON.GEO'
7850 include 'COMMON.FFIELD'
7851 double precision ggg1(3),ggg2(3)
7852 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7857 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7865 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7866 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7870 derx(lll,kkk,iii)=0.0d0
7874 cd eij=facont_hb(jj,i)
7875 cd ekl=facont_hb(kk,k)
7881 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7882 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7883 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7884 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7885 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7886 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7888 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7889 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7890 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7891 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7892 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7893 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7897 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7899 C If turn contributions are considered, they will be handled separately.
7900 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7901 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7902 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7903 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7904 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7905 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7906 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7909 if (j.lt.nres-1) then
7916 if (l.lt.nres-1) then
7924 ggg1(ll)=eel6*g_contij(ll,1)
7925 ggg2(ll)=eel6*g_contij(ll,2)
7926 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7927 ghalf=0.5d0*ggg1(ll)
7929 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7930 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7931 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7932 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7933 ghalf=0.5d0*ggg2(ll)
7934 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7936 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7937 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7938 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7939 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7944 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7945 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7950 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7951 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7957 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7962 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7966 cd write (2,*) iii,g_corr6_loc(iii)
7970 cd write (2,*) 'ekont',ekont
7971 cd write (iout,*) 'eello6',ekont*eel6
7974 c--------------------------------------------------------------------------
7975 double precision function eello6_graph1(i,j,k,l,imat,swap)
7976 implicit real*8 (a-h,o-z)
7977 include 'DIMENSIONS'
7978 include 'sizesclu.dat'
7979 include 'COMMON.IOUNITS'
7980 include 'COMMON.CHAIN'
7981 include 'COMMON.DERIV'
7982 include 'COMMON.INTERACT'
7983 include 'COMMON.CONTACTS'
7984 include 'COMMON.TORSION'
7985 include 'COMMON.VAR'
7986 include 'COMMON.GEO'
7987 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7991 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7993 C Parallel Antiparallel C
7999 C \ j|/k\| / \ |/k\|l / C
8004 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8005 itk=itortyp(itype(k))
8006 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8007 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8008 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8009 call transpose2(EUgC(1,1,k),auxmat(1,1))
8010 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8011 vv1(1)=pizda1(1,1)-pizda1(2,2)
8012 vv1(2)=pizda1(1,2)+pizda1(2,1)
8013 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8014 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8015 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8016 s5=scalar2(vv(1),Dtobr2(1,i))
8017 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8018 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8019 if (.not. calc_grad) return
8020 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8021 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8022 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8023 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8024 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8025 & +scalar2(vv(1),Dtobr2der(1,i)))
8026 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8027 vv1(1)=pizda1(1,1)-pizda1(2,2)
8028 vv1(2)=pizda1(1,2)+pizda1(2,1)
8029 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8030 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8032 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8033 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8034 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8035 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8036 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8038 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8039 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8040 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8041 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8042 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8044 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8045 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8046 vv1(1)=pizda1(1,1)-pizda1(2,2)
8047 vv1(2)=pizda1(1,2)+pizda1(2,1)
8048 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8049 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8050 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8051 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8060 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8061 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8062 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8063 call transpose2(EUgC(1,1,k),auxmat(1,1))
8064 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8066 vv1(1)=pizda1(1,1)-pizda1(2,2)
8067 vv1(2)=pizda1(1,2)+pizda1(2,1)
8068 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8069 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8070 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8071 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8072 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8073 s5=scalar2(vv(1),Dtobr2(1,i))
8074 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8080 c----------------------------------------------------------------------------
8081 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8082 implicit real*8 (a-h,o-z)
8083 include 'DIMENSIONS'
8084 include 'sizesclu.dat'
8085 include 'COMMON.IOUNITS'
8086 include 'COMMON.CHAIN'
8087 include 'COMMON.DERIV'
8088 include 'COMMON.INTERACT'
8089 include 'COMMON.CONTACTS'
8090 include 'COMMON.TORSION'
8091 include 'COMMON.VAR'
8092 include 'COMMON.GEO'
8094 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8095 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8098 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8100 C Parallel Antiparallel C
8106 C \ j|/k\| \ |/k\|l C
8111 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8112 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8113 C AL 7/4/01 s1 would occur in the sixth-order moment,
8114 C but not in a cluster cumulant
8116 s1=dip(1,jj,i)*dip(1,kk,k)
8118 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8119 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8120 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8121 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8122 call transpose2(EUg(1,1,k),auxmat(1,1))
8123 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8124 vv(1)=pizda(1,1)-pizda(2,2)
8125 vv(2)=pizda(1,2)+pizda(2,1)
8126 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8127 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8129 eello6_graph2=-(s1+s2+s3+s4)
8131 eello6_graph2=-(s2+s3+s4)
8134 if (.not. calc_grad) return
8135 C Derivatives in gamma(i-1)
8138 s1=dipderg(1,jj,i)*dip(1,kk,k)
8140 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8141 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8142 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8143 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8145 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8147 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8149 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8151 C Derivatives in gamma(k-1)
8153 s1=dip(1,jj,i)*dipderg(1,kk,k)
8155 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8156 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8157 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8158 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8159 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8160 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8161 vv(1)=pizda(1,1)-pizda(2,2)
8162 vv(2)=pizda(1,2)+pizda(2,1)
8163 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8165 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8167 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8169 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8170 C Derivatives in gamma(j-1) or gamma(l-1)
8173 s1=dipderg(3,jj,i)*dip(1,kk,k)
8175 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8176 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8177 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8178 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8179 vv(1)=pizda(1,1)-pizda(2,2)
8180 vv(2)=pizda(1,2)+pizda(2,1)
8181 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8184 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8186 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8189 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8190 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8192 C Derivatives in gamma(l-1) or gamma(j-1)
8195 s1=dip(1,jj,i)*dipderg(3,kk,k)
8197 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8198 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8199 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8200 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8201 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8202 vv(1)=pizda(1,1)-pizda(2,2)
8203 vv(2)=pizda(1,2)+pizda(2,1)
8204 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8207 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8209 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8212 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8213 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8215 C Cartesian derivatives.
8217 write (2,*) 'In eello6_graph2'
8219 write (2,*) 'iii=',iii
8221 write (2,*) 'kkk=',kkk
8223 write (2,'(3(2f10.5),5x)')
8224 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8234 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8236 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8239 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8241 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8242 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8244 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8245 call transpose2(EUg(1,1,k),auxmat(1,1))
8246 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8248 vv(1)=pizda(1,1)-pizda(2,2)
8249 vv(2)=pizda(1,2)+pizda(2,1)
8250 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8251 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8253 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8255 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8258 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8260 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8267 c----------------------------------------------------------------------------
8268 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8269 implicit real*8 (a-h,o-z)
8270 include 'DIMENSIONS'
8271 include 'sizesclu.dat'
8272 include 'COMMON.IOUNITS'
8273 include 'COMMON.CHAIN'
8274 include 'COMMON.DERIV'
8275 include 'COMMON.INTERACT'
8276 include 'COMMON.CONTACTS'
8277 include 'COMMON.TORSION'
8278 include 'COMMON.VAR'
8279 include 'COMMON.GEO'
8280 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8282 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8284 C Parallel Antiparallel C
8290 C j|/k\| / |/k\|l / C
8295 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8297 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8298 C energy moment and not to the cluster cumulant.
8299 iti=itortyp(itype(i))
8300 if (j.lt.nres-1) then
8301 itj1=itortyp(itype(j+1))
8305 itk=itortyp(itype(k))
8306 itk1=itortyp(itype(k+1))
8307 if (l.lt.nres-1) then
8308 itl1=itortyp(itype(l+1))
8313 s1=dip(4,jj,i)*dip(4,kk,k)
8315 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8316 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8317 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8318 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8319 call transpose2(EE(1,1,itk),auxmat(1,1))
8320 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8321 vv(1)=pizda(1,1)+pizda(2,2)
8322 vv(2)=pizda(2,1)-pizda(1,2)
8323 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8324 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8326 eello6_graph3=-(s1+s2+s3+s4)
8328 eello6_graph3=-(s2+s3+s4)
8331 if (.not. calc_grad) return
8332 C Derivatives in gamma(k-1)
8333 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8334 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8335 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8336 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8337 C Derivatives in gamma(l-1)
8338 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8339 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8340 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8341 vv(1)=pizda(1,1)+pizda(2,2)
8342 vv(2)=pizda(2,1)-pizda(1,2)
8343 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8344 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8345 C Cartesian derivatives.
8351 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8353 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8356 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8358 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8359 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8361 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8362 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8364 vv(1)=pizda(1,1)+pizda(2,2)
8365 vv(2)=pizda(2,1)-pizda(1,2)
8366 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8368 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8370 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8373 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8375 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8377 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8383 c----------------------------------------------------------------------------
8384 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8385 implicit real*8 (a-h,o-z)
8386 include 'DIMENSIONS'
8387 include 'sizesclu.dat'
8388 include 'COMMON.IOUNITS'
8389 include 'COMMON.CHAIN'
8390 include 'COMMON.DERIV'
8391 include 'COMMON.INTERACT'
8392 include 'COMMON.CONTACTS'
8393 include 'COMMON.TORSION'
8394 include 'COMMON.VAR'
8395 include 'COMMON.GEO'
8396 include 'COMMON.FFIELD'
8397 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8398 & auxvec1(2),auxmat1(2,2)
8400 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8402 C Parallel Antiparallel C
8408 C \ j|/k\| \ |/k\|l C
8413 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8415 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8416 C energy moment and not to the cluster cumulant.
8417 cd write (2,*) 'eello_graph4: wturn6',wturn6
8418 iti=itortyp(itype(i))
8419 itj=itortyp(itype(j))
8420 if (j.lt.nres-1) then
8421 itj1=itortyp(itype(j+1))
8425 itk=itortyp(itype(k))
8426 if (k.lt.nres-1) then
8427 itk1=itortyp(itype(k+1))
8431 itl=itortyp(itype(l))
8432 if (l.lt.nres-1) then
8433 itl1=itortyp(itype(l+1))
8437 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8438 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8439 cd & ' itl',itl,' itl1',itl1
8442 s1=dip(3,jj,i)*dip(3,kk,k)
8444 s1=dip(2,jj,j)*dip(2,kk,l)
8447 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8448 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8450 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8451 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8453 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8454 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8456 call transpose2(EUg(1,1,k),auxmat(1,1))
8457 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8458 vv(1)=pizda(1,1)-pizda(2,2)
8459 vv(2)=pizda(2,1)+pizda(1,2)
8460 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8461 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8463 eello6_graph4=-(s1+s2+s3+s4)
8465 eello6_graph4=-(s2+s3+s4)
8467 if (.not. calc_grad) return
8468 C Derivatives in gamma(i-1)
8472 s1=dipderg(2,jj,i)*dip(3,kk,k)
8474 s1=dipderg(4,jj,j)*dip(2,kk,l)
8477 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8479 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8480 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8482 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8483 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8485 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8486 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8487 cd write (2,*) 'turn6 derivatives'
8489 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8491 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8495 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8497 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8501 C Derivatives in gamma(k-1)
8504 s1=dip(3,jj,i)*dipderg(2,kk,k)
8506 s1=dip(2,jj,j)*dipderg(4,kk,l)
8509 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8510 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8512 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8513 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8515 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8516 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8518 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8519 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8520 vv(1)=pizda(1,1)-pizda(2,2)
8521 vv(2)=pizda(2,1)+pizda(1,2)
8522 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8523 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8525 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8527 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8531 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8533 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8536 C Derivatives in gamma(j-1) or gamma(l-1)
8537 if (l.eq.j+1 .and. l.gt.1) then
8538 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8539 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8540 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8541 vv(1)=pizda(1,1)-pizda(2,2)
8542 vv(2)=pizda(2,1)+pizda(1,2)
8543 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8544 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8545 else if (j.gt.1) then
8546 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8547 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8548 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8549 vv(1)=pizda(1,1)-pizda(2,2)
8550 vv(2)=pizda(2,1)+pizda(1,2)
8551 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8552 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8553 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8555 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8558 C Cartesian derivatives.
8565 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8567 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8571 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8573 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8577 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8579 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8581 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8582 & b1(1,itj1),auxvec(1))
8583 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8585 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8586 & b1(1,itl1),auxvec(1))
8587 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8589 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8591 vv(1)=pizda(1,1)-pizda(2,2)
8592 vv(2)=pizda(2,1)+pizda(1,2)
8593 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8595 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8597 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8600 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8603 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8606 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8608 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8610 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8614 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8616 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8619 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8621 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8629 c----------------------------------------------------------------------------
8630 double precision function eello_turn6(i,jj,kk)
8631 implicit real*8 (a-h,o-z)
8632 include 'DIMENSIONS'
8633 include 'sizesclu.dat'
8634 include 'COMMON.IOUNITS'
8635 include 'COMMON.CHAIN'
8636 include 'COMMON.DERIV'
8637 include 'COMMON.INTERACT'
8638 include 'COMMON.CONTACTS'
8639 include 'COMMON.TORSION'
8640 include 'COMMON.VAR'
8641 include 'COMMON.GEO'
8642 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8643 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8645 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8646 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8647 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8648 C the respective energy moment and not to the cluster cumulant.
8653 iti=itortyp(itype(i))
8654 itk=itortyp(itype(k))
8655 itk1=itortyp(itype(k+1))
8656 itl=itortyp(itype(l))
8657 itj=itortyp(itype(j))
8658 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8659 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8660 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8665 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8667 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8671 derx_turn(lll,kkk,iii)=0.0d0
8678 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8680 cd write (2,*) 'eello6_5',eello6_5
8682 call transpose2(AEA(1,1,1),auxmat(1,1))
8683 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8684 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8685 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8689 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8690 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8691 s2 = scalar2(b1(1,itk),vtemp1(1))
8693 call transpose2(AEA(1,1,2),atemp(1,1))
8694 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8695 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8696 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8700 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8701 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8702 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8704 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8705 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8706 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8707 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8708 ss13 = scalar2(b1(1,itk),vtemp4(1))
8709 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8713 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8719 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8721 C Derivatives in gamma(i+2)
8723 call transpose2(AEA(1,1,1),auxmatd(1,1))
8724 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8725 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8726 call transpose2(AEAderg(1,1,2),atempd(1,1))
8727 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8728 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8732 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8733 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8734 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8740 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8741 C Derivatives in gamma(i+3)
8743 call transpose2(AEA(1,1,1),auxmatd(1,1))
8744 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8745 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8746 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8750 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8751 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8752 s2d = scalar2(b1(1,itk),vtemp1d(1))
8754 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8755 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8757 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8759 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8760 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8761 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8771 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8772 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8774 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8775 & -0.5d0*ekont*(s2d+s12d)
8777 C Derivatives in gamma(i+4)
8778 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8779 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8780 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8782 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8783 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8784 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8794 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8796 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8798 C Derivatives in gamma(i+5)
8800 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8801 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8802 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8806 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8807 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8808 s2d = scalar2(b1(1,itk),vtemp1d(1))
8810 call transpose2(AEA(1,1,2),atempd(1,1))
8811 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8812 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8816 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8817 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8819 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8820 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8821 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8831 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8832 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8834 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8835 & -0.5d0*ekont*(s2d+s12d)
8837 C Cartesian derivatives
8842 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8843 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8844 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8848 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8849 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8851 s2d = scalar2(b1(1,itk),vtemp1d(1))
8853 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8854 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8855 s8d = -(atempd(1,1)+atempd(2,2))*
8856 & scalar2(cc(1,1,itl),vtemp2(1))
8860 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8862 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8863 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8870 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8873 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8877 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8878 & - 0.5d0*(s8d+s12d)
8880 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8889 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8891 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8892 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8893 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8894 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8895 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8897 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8898 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8899 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8903 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8904 cd & 16*eel_turn6_num
8906 if (j.lt.nres-1) then
8913 if (l.lt.nres-1) then
8921 ggg1(ll)=eel_turn6*g_contij(ll,1)
8922 ggg2(ll)=eel_turn6*g_contij(ll,2)
8923 ghalf=0.5d0*ggg1(ll)
8925 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8926 & +ekont*derx_turn(ll,2,1)
8927 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8928 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8929 & +ekont*derx_turn(ll,4,1)
8930 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8931 ghalf=0.5d0*ggg2(ll)
8933 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8934 & +ekont*derx_turn(ll,2,2)
8935 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8936 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8937 & +ekont*derx_turn(ll,4,2)
8938 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8943 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8948 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8954 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8959 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8963 cd write (2,*) iii,g_corr6_loc(iii)
8966 eello_turn6=ekont*eel_turn6
8967 cd write (2,*) 'ekont',ekont
8968 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8971 crc-------------------------------------------------
8972 SUBROUTINE MATVEC2(A1,V1,V2)
8973 implicit real*8 (a-h,o-z)
8974 include 'DIMENSIONS'
8975 DIMENSION A1(2,2),V1(2),V2(2)
8979 c 3 VI=VI+A1(I,K)*V1(K)
8983 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8984 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8989 C---------------------------------------
8990 SUBROUTINE MATMAT2(A1,A2,A3)
8991 implicit real*8 (a-h,o-z)
8992 include 'DIMENSIONS'
8993 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8994 c DIMENSION AI3(2,2)
8998 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9004 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9005 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9006 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9007 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9015 c-------------------------------------------------------------------------
9016 double precision function scalar2(u,v)
9018 double precision u(2),v(2)
9021 scalar2=u(1)*v(1)+u(2)*v(2)
9025 C-----------------------------------------------------------------------------
9027 subroutine transpose2(a,at)
9029 double precision a(2,2),at(2,2)
9036 c--------------------------------------------------------------------------
9037 subroutine transpose(n,a,at)
9040 double precision a(n,n),at(n,n)
9048 C---------------------------------------------------------------------------
9049 subroutine prodmat3(a1,a2,kk,transp,prod)
9052 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9054 crc double precision auxmat(2,2),prod_(2,2)
9057 crc call transpose2(kk(1,1),auxmat(1,1))
9058 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9059 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9061 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9062 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9063 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9064 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9065 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9066 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9067 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9068 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9071 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9072 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9074 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9075 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9076 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9077 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9078 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9079 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9080 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9081 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9084 c call transpose2(a2(1,1),a2t(1,1))
9087 crc print *,((prod_(i,j),i=1,2),j=1,2)
9088 crc print *,((prod(i,j),i=1,2),j=1,2)
9092 C-----------------------------------------------------------------------------
9093 double precision function scalar(u,v)
9095 double precision u(3),v(3)