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 ! Scale down the repulsive term for 1,4 interactions.
1090 if (iabs(j-i).le.4) c1 = 0.01d0 * c1
1093 c2 = fac * bb(itypi,itypj)
1095 c write (2,*) "eps1",eps1," eps2rt",eps2rt," eps3rt",eps3rt,
1096 c & " c1",c1," c2",c2
1097 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
1098 eps2der = eps3rt * evdwij
1099 eps3der = eps2rt * evdwij
1100 c! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
1101 evdwij = eps2rt * eps3rt * evdwij
1103 c! write (*,*) "Gey Berne = ", evdwij
1105 IF (bb(itypi,itypj).gt.0) THEN
1106 evdw_p = evdw_p + evdwij
1108 evdw_m = evdw_m + evdwij
1114 c!-------------------------------------------------------------------
1115 c! Calculate some components of GGB
1116 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
1117 fac = -expon * (c1 + evdwij) * rij_shift
1118 sigder = fac * sigder
1120 c! Calculate distance derivative
1127 c! write (*,*) "gg(1) = ", gg(1)
1128 c! write (*,*) "gg(2) = ", gg(2)
1129 c! write (*,*) "gg(3) = ", gg(3)
1130 c! The angular derivatives of GGB are brought together in sc_grad
1131 c!-------------------------------------------------------------------
1134 c! Catch gly-gly interactions to skip calculation of something that
1137 IF (itypi.eq.10.and.itypj.eq.10) THEN
1145 c! we are not 2 glycines, so we calculate Fcav (and maybe more)
1146 fac = chis1 * sqom1 + chis2 * sqom2
1147 & - 2.0d0 * chis12 * om1 * om2 * om12
1148 c! we will use pom later in Gcav, so dont mess with it!
1149 pom = 1.0d0 - chis1 * chis2 * sqom12
1151 Lambf = (1.0d0 - (fac / pom))
1152 Lambf = dsqrt(Lambf)
1155 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
1156 c! write (*,*) "sparrow = ", sparrow
1157 Chif = Rtail * sparrow
1158 ChiLambf = Chif * Lambf
1159 eagle = dsqrt(ChiLambf)
1160 bat = ChiLambf ** 11.0d0
1162 top = b1 * ( eagle + b2 * ChiLambf - b3 )
1163 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
1166 c! write (*,*) "sig1 = ",sig1
1167 c! write (*,*) "sig2 = ",sig2
1168 c! write (*,*) "Rtail = ",Rtail
1169 c! write (*,*) "sparrow = ",sparrow
1170 c! write (*,*) "Chis1 = ", chis1
1171 c! write (*,*) "Chis2 = ", chis2
1172 c! write (*,*) "Chis12 = ", chis12
1173 c! write (*,*) "om1 = ", om1
1174 c! write (*,*) "om2 = ", om2
1175 c! write (*,*) "om12 = ", om12
1176 c! write (*,*) "sqom1 = ", sqom1
1177 c! write (*,*) "sqom2 = ", sqom2
1178 c! write (*,*) "sqom12 = ", sqom12
1179 c! write (*,*) "Lambf = ",Lambf
1180 c! write (*,*) "b1 = ",b1
1181 c! write (*,*) "b2 = ",b2
1182 c! write (*,*) "b3 = ",b3
1183 c! write (*,*) "b4 = ",b4
1184 c! write (*,*) "top = ",top
1185 c! write (*,*) "bot = ",bot
1188 c! write (*,*) "Fcav = ", Fcav
1189 c!-------------------------------------------------------------------
1190 c! derivative of Fcav is Gcav...
1191 c!---------------------------------------------------
1193 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
1194 dbot = 12.0d0 * b4 * bat * Lambf
1195 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
1197 c! write (*,*) "dFcav/dR = ", dFdR
1199 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
1200 dbot = 12.0d0 * b4 * bat * Chif
1202 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
1203 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
1204 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2)
1205 & * (chis2 * om2 * om12 - om1) / (eagle * pom)
1207 dFdL = ((dtop * bot - top * dbot) / botsq)
1209 dCAVdOM1 = dFdL * ( dFdOM1 )
1210 dCAVdOM2 = dFdL * ( dFdOM2 )
1211 dCAVdOM12 = dFdL * ( dFdOM12 )
1212 c! write (*,*) "dFcav/dOM1 = ", dCAVdOM1
1213 c! write (*,*) "dFcav/dOM2 = ", dCAVdOM2
1214 c! write (*,*) "dFcav/dOM12 = ", dCAVdOM12
1216 c!-------------------------------------------------------------------
1217 c! Finally, add the distance derivatives of GB and Fcav to gvdwc
1218 c! Pom is used here to project the gradient vector into
1219 c! cartesian coordinates and at the same time contains
1220 c! dXhb/dXsc derivative (for charged amino acids
1221 c! location of hydrophobic centre of interaction is not
1222 c! the same as geometric centre of side chain, this
1223 c! derivative takes that into account)
1224 c! derivatives of omega angles will be added in sc_grad
1227 ertail(k) = Rtail_distance(k)/Rtail
1229 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
1230 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
1231 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1232 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1234 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1235 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1236 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
1237 gvdwx(k,i) = gvdwx(k,i)
1238 & - (( dFdR + gg(k) ) * pom)
1239 c! & - ( dFdR * pom )
1240 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
1241 gvdwx(k,j) = gvdwx(k,j)
1242 & + (( dFdR + gg(k) ) * pom)
1243 c! & + ( dFdR * pom )
1245 gvdwc(k,i) = gvdwc(k,i)
1246 & - (( dFdR + gg(k) ) * ertail(k))
1247 c! & - ( dFdR * ertail(k))
1249 gvdwc(k,j) = gvdwc(k,j)
1250 & + (( dFdR + gg(k) ) * ertail(k))
1251 c! & + ( dFdR * ertail(k))
1254 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1255 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1258 c!-------------------------------------------------------------------
1259 c! Compute head-head and head-tail energies for each state
1261 isel = iabs(Qi) + iabs(Qj)
1263 c! No charges - do nothing
1266 ELSE IF (isel.eq.4) THEN
1267 c! Calculate dipole-dipole interactions
1271 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
1272 c! Charge-nonpolar interactions
1276 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
1277 c! Nonpolar-charge interactions
1281 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
1282 c! Charge-dipole interactions
1283 CALL eqd(ecl, elj, epol)
1284 eheadtail = ECL + elj + epol
1286 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
1287 c! Dipole-charge interactions
1288 CALL edq(ecl, elj, epol)
1289 eheadtail = ECL + elj + epol
1291 ELSE IF ((isel.eq.2.and.
1292 & iabs(Qi).eq.1).and.
1293 & nstate(itypi,itypj).eq.1) THEN
1294 c! Same charge-charge interaction ( +/+ or -/- )
1295 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
1296 eheadtail = ECL + Egb + Epol + Fisocav + Elj
1298 ELSE IF ((isel.eq.2.and.
1299 & iabs(Qi).eq.1).and.
1300 & nstate(itypi,itypj).ne.1) THEN
1301 c! Different charge-charge interaction ( +/- or -/+ )
1303 & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1305 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
1306 c! write (*,*) "evdw = ", evdw
1307 c! write (*,*) "Fcav = ", Fcav
1308 c! write (*,*) "eheadtail = ", eheadtail
1312 IF (energy_dec) write (iout,'(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,
1316 IF (energy_dec) write (*,'(2(1x,a3,i3),3f6.2,9f16.7)')
1317 & restyp(itype(i)),i,restyp(itype(j)),j,
1318 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1325 c!-------------------------------------------------------------------
1326 c! As all angular derivatives are done, now we sum them up,
1327 c! then transform and project into cartesian vectors and add to gvdwc
1328 c! We call sc_grad always, with the exception of +/- interaction.
1329 c! This is because energy_quad subroutine needs to handle
1330 c! this job in his own way.
1331 c! This IS probably not very efficient and SHOULD be optimised
1332 c! but it will require major restructurization of emomo
1333 c! so it will be left as it is for now
1334 c! write (*,*) 'troll1, nstate =', nstate (itypi,itypj)
1335 IF (nstate(itypi,itypj).eq.1) THEN
1337 IF (bb(itypi,itypj).gt.0) THEN
1346 c!-------------------------------------------------------------------
1351 c write (iout,*) "Number of loop steps in EGB:",ind
1352 c energy_dec=.false.
1354 END SUBROUTINE emomo
1358 C-----------------------------------------------------------------------------
1361 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
1363 INCLUDE 'DIMENSIONS'
1364 INCLUDE 'sizesclu.dat'
1365 INCLUDE 'COMMON.CALC'
1366 INCLUDE 'COMMON.CHAIN'
1367 INCLUDE 'COMMON.CONTROL'
1368 INCLUDE 'COMMON.DERIV'
1369 INCLUDE 'COMMON.EMP'
1370 INCLUDE 'COMMON.GEO'
1371 INCLUDE 'COMMON.INTERACT'
1372 INCLUDE 'COMMON.IOUNITS'
1373 INCLUDE 'COMMON.LOCAL'
1374 INCLUDE 'COMMON.NAMES'
1375 INCLUDE 'COMMON.VAR'
1376 double precision scalar, facd3, facd4, federmaus, adler
1377 c! Epol and Gpol analytical parameters
1378 alphapol1 = alphapol(itypi,itypj)
1379 alphapol2 = alphapol(itypj,itypi)
1380 c! Fisocav and Gisocav analytical parameters
1381 al1 = alphiso(1,itypi,itypj)
1382 al2 = alphiso(2,itypi,itypj)
1383 al3 = alphiso(3,itypi,itypj)
1384 al4 = alphiso(4,itypi,itypj)
1386 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1387 & + sigiso2(itypi,itypj)**2.0d0))
1389 pis = sig0head(itypi,itypj)
1390 eps_head = epshead(itypi,itypj)
1391 Rhead_sq = Rhead * Rhead
1392 c! R1 - distance between head of ith side chain and tail of jth sidechain
1393 c! R2 - distance between head of jth side chain and tail of ith sidechain
1397 c! Calculate head-to-tail distances needed by Epol
1398 R1=R1+(ctail(k,2)-chead(k,1))**2
1399 R2=R2+(chead(k,2)-ctail(k,1))**2
1405 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1406 c! & +dhead(1,1,itypi,itypj))**2))
1407 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1408 c! & +dhead(2,1,itypi,itypj))**2))
1410 c!-------------------------------------------------------------------
1411 c! Coulomb electrostatic interaction
1412 Ecl = (332.0d0 * Qij) / Rhead
1413 c! derivative of Ecl is Gcl...
1414 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
1418 c!-------------------------------------------------------------------
1419 c! Generalised Born Solvent Polarization
1420 c! Charged head polarizes the solvent
1421 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1422 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1423 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1424 c! Derivative of Egb is Ggb...
1425 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1426 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1428 dGGBdR = dGGBdFGB * dFGBdR
1429 c!-------------------------------------------------------------------
1430 c! Fisocav - isotropic cavity creation term
1431 c! or "how much energy it costs to put charged head in water"
1433 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1434 bot = (1.0d0 + al4 * pom**12.0d0)
1437 c! write (*,*) "Rhead = ",Rhead
1438 c! write (*,*) "csig = ",csig
1439 c! write (*,*) "pom = ",pom
1440 c! write (*,*) "al1 = ",al1
1441 c! write (*,*) "al2 = ",al2
1442 c! write (*,*) "al3 = ",al3
1443 c! write (*,*) "al4 = ",al4
1444 c! write (*,*) "top = ",top
1445 c! write (*,*) "bot = ",bot
1446 c! Derivative of Fisocav is GCV...
1447 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1448 dbot = 12.0d0 * al4 * pom ** 11.0d0
1449 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1450 c!-------------------------------------------------------------------
1452 c! Polarization energy - charged heads polarize hydrophobic "neck"
1453 MomoFac1 = (1.0d0 - chi1 * sqom2)
1454 MomoFac2 = (1.0d0 - chi2 * sqom1)
1455 RR1 = ( R1 * R1 ) / MomoFac1
1456 RR2 = ( R2 * R2 ) / MomoFac2
1457 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1458 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1459 fgb1 = sqrt( RR1 + a12sq * ee1 )
1460 fgb2 = sqrt( RR2 + a12sq * ee2 )
1461 epol = 332.0d0 * eps_inout_fac * (
1462 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1464 c write (*,*) "eps_inout_fac = ",eps_inout_fac
1465 c write (*,*) "alphapol1 = ", alphapol1
1466 c write (*,*) "alphapol2 = ", alphapol2
1467 c write (*,*) "fgb1 = ", fgb1
1468 c write (*,*) "fgb2 = ", fgb2
1469 c write (*,*) "epol = ", epol
1470 c! derivative of Epol is Gpol...
1471 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1473 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1475 dFGBdR1 = ( (R1 / MomoFac1)
1476 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1477 & / ( 2.0d0 * fgb1 )
1478 dFGBdR2 = ( (R2 / MomoFac2)
1479 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1480 & / ( 2.0d0 * fgb2 )
1481 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1482 & * ( 2.0d0 - 0.5d0 * ee1) )
1483 & / ( 2.0d0 * fgb1 )
1484 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1485 & * ( 2.0d0 - 0.5d0 * ee2) )
1486 & / ( 2.0d0 * fgb2 )
1487 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1489 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1491 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1493 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1495 c!-------------------------------------------------------------------
1497 c! Lennard-Jones 6-12 interaction between heads
1498 pom = (pis / Rhead)**6.0d0
1499 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1500 c! derivative of Elj is Glj
1501 dGLJdR = 4.0d0 * eps_head
1502 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1503 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1504 c!-------------------------------------------------------------------
1505 c! Return the results
1506 c! These things do the dRdX derivatives, that is
1507 c! allow us to change what we see from function that changes with
1508 c! distance to function that changes with LOCATION (of the interaction
1511 erhead(k) = Rhead_distance(k)/Rhead
1512 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1513 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1516 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1517 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1518 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1519 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1520 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1521 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1522 facd1 = d1 * vbld_inv(i+nres)
1523 facd2 = d2 * vbld_inv(j+nres)
1524 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1525 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1527 c! Now we add appropriate partial derivatives (one in each dimension)
1529 hawk = (erhead_tail(k,1) +
1530 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
1531 condor = (erhead_tail(k,2) +
1532 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
1534 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1535 gvdwx(k,i) = gvdwx(k,i)
1540 & - dPOLdR2 * (erhead_tail(k,2)
1541 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1544 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1545 gvdwx(k,j) = gvdwx(k,j)
1549 & + dPOLdR1 * (erhead_tail(k,1)
1550 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1551 & + dPOLdR2 * condor
1554 gvdwc(k,i) = gvdwc(k,i)
1555 & - dGCLdR * erhead(k)
1556 & - dGGBdR * erhead(k)
1557 & - dGCVdR * erhead(k)
1558 & - dPOLdR1 * erhead_tail(k,1)
1559 & - dPOLdR2 * erhead_tail(k,2)
1560 & - dGLJdR * erhead(k)
1562 gvdwc(k,j) = gvdwc(k,j)
1563 & + dGCLdR * erhead(k)
1564 & + dGGBdR * erhead(k)
1565 & + dGCVdR * erhead(k)
1566 & + dPOLdR1 * erhead_tail(k,1)
1567 & + dPOLdR2 * erhead_tail(k,2)
1568 & + dGLJdR * erhead(k)
1573 c!-------------------------------------------------------------------
1574 SUBROUTINE energy_quad
1575 &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1577 INCLUDE 'DIMENSIONS'
1578 INCLUDE 'sizesclu.dat'
1579 INCLUDE 'COMMON.CALC'
1580 INCLUDE 'COMMON.CHAIN'
1581 INCLUDE 'COMMON.CONTROL'
1582 INCLUDE 'COMMON.DERIV'
1583 INCLUDE 'COMMON.EMP'
1584 INCLUDE 'COMMON.GEO'
1585 INCLUDE 'COMMON.INTERACT'
1586 INCLUDE 'COMMON.IOUNITS'
1587 INCLUDE 'COMMON.LOCAL'
1588 INCLUDE 'COMMON.NAMES'
1589 INCLUDE 'COMMON.VAR'
1590 double precision scalar
1591 double precision ener(4)
1592 double precision dcosom1(3),dcosom2(3)
1593 c! used in Epol derivatives
1594 double precision facd3, facd4
1595 double precision federmaus, adler
1596 c! Epol and Gpol analytical parameters
1597 alphapol1 = alphapol(itypi,itypj)
1598 alphapol2 = alphapol(itypj,itypi)
1599 c! Fisocav and Gisocav analytical parameters
1600 al1 = alphiso(1,itypi,itypj)
1601 al2 = alphiso(2,itypi,itypj)
1602 al3 = alphiso(3,itypi,itypj)
1603 al4 = alphiso(4,itypi,itypj)
1605 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1606 & + sigiso2(itypi,itypj)**2.0d0))
1608 w1 = wqdip(1,itypi,itypj)
1609 w2 = wqdip(2,itypi,itypj)
1610 pis = sig0head(itypi,itypj)
1611 eps_head = epshead(itypi,itypj)
1612 c! First things first:
1613 c! We need to do sc_grad's job with GB and Fcav
1615 & eps2der * eps2rt_om1
1616 & - 2.0D0 * alf1 * eps3der
1617 & + sigder * sigsq_om1
1620 & eps2der * eps2rt_om2
1621 & + 2.0D0 * alf2 * eps3der
1622 & + sigder * sigsq_om2
1625 & evdwij * eps1_om12
1626 & + eps2der * eps2rt_om12
1627 & - 2.0D0 * alf12 * eps3der
1628 & + sigder *sigsq_om12
1630 c! now some magical transformations to project gradient into
1631 c! three cartesian vectors
1633 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1634 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1635 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
1636 c! this acts on hydrophobic center of interaction
1637 gvdwx(k,i)= gvdwx(k,i) - gg(k)
1638 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1639 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1640 gvdwx(k,j)= gvdwx(k,j) + gg(k)
1641 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1642 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1643 c! this acts on Calpha
1644 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1645 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1647 c! sc_grad is done, now we will compute
1656 c! d1 = dhead(1, 1, itypi, itypj)
1657 c! d2 = dhead(2, 1, itypi, itypj)
1658 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1659 c! & +dhead(1,ii,itypi,itypj))**2))
1660 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1661 c! & +dhead(2,jj,itypi,itypj))**2))
1662 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1663 c! END OF ENERGY DEBUG
1664 c*************************************************************
1665 DO istate = 1, nstate(itypi,itypj)
1666 c*************************************************************
1667 IF (istate.ne.1) THEN
1668 IF (istate.lt.3) THEN
1674 d1 = dhead(1,ii,itypi,itypj)
1675 d2 = dhead(2,jj,itypi,itypj)
1677 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
1678 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
1679 Rhead_distance(k) = chead(k,2) - chead(k,1)
1681 c! pitagoras (root of sum of squares)
1683 & (Rhead_distance(1)*Rhead_distance(1))
1684 & + (Rhead_distance(2)*Rhead_distance(2))
1685 & + (Rhead_distance(3)*Rhead_distance(3)))
1687 Rhead_sq = Rhead * Rhead
1689 c! R1 - distance between head of ith side chain and tail of jth sidechain
1690 c! R2 - distance between head of jth side chain and tail of ith sidechain
1694 c! Calculate head-to-tail distances
1695 R1=R1+(ctail(k,2)-chead(k,1))**2
1696 R2=R2+(chead(k,2)-ctail(k,1))**2
1703 c! write (*,*) "istate = ", istate
1704 c! write (*,*) "ii = ", ii
1705 c! write (*,*) "jj = ", jj
1706 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1707 c! & +dhead(1,ii,itypi,itypj))**2))
1708 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1709 c! & +dhead(2,jj,itypi,itypj))**2))
1710 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1711 c! Rhead_sq = Rhead * Rhead
1712 c! write (*,*) "d1 = ",d1
1713 c! write (*,*) "d2 = ",d2
1714 c! write (*,*) "R1 = ",R1
1715 c! write (*,*) "R2 = ",R2
1716 c! write (*,*) "Rhead = ",Rhead
1717 c! END OF ENERGY DEBUG
1719 c!-------------------------------------------------------------------
1720 c! Coulomb electrostatic interaction
1721 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
1723 c! write (*,*) "Ecl = ", Ecl
1724 c! derivative of Ecl is Gcl...
1725 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
1730 c!-------------------------------------------------------------------
1731 c! Generalised Born Solvent Polarization
1732 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1733 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1734 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1736 c! write (*,*) "a1*a2 = ", a12sq
1737 c! write (*,*) "Rhead = ", Rhead
1738 c! write (*,*) "Rhead_sq = ", Rhead_sq
1739 c! write (*,*) "ee = ", ee
1740 c! write (*,*) "Fgb = ", Fgb
1741 c! write (*,*) "fac = ", eps_inout_fac
1742 c! write (*,*) "Qij = ", Qij
1743 c! write (*,*) "Egb = ", Egb
1744 c! Derivative of Egb is Ggb...
1745 c! dFGBdR is used by Quad's later...
1746 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1747 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1749 dGGBdR = dGGBdFGB * dFGBdR
1751 c!-------------------------------------------------------------------
1752 c! Fisocav - isotropic cavity creation term
1754 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1755 bot = (1.0d0 + al4 * pom**12.0d0)
1759 c! write (*,*) "pom = ",pom
1760 c! write (*,*) "al1 = ",al1
1761 c! write (*,*) "al2 = ",al2
1762 c! write (*,*) "al3 = ",al3
1763 c! write (*,*) "al4 = ",al4
1764 c! write (*,*) "top = ",top
1765 c! write (*,*) "bot = ",bot
1766 c! write (*,*) "Fisocav = ", Fisocav
1768 c! Derivative of Fisocav is GCV...
1769 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1770 dbot = 12.0d0 * al4 * pom ** 11.0d0
1771 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1773 c!-------------------------------------------------------------------
1774 c! Polarization energy
1776 MomoFac1 = (1.0d0 - chi1 * sqom2)
1777 MomoFac2 = (1.0d0 - chi2 * sqom1)
1778 RR1 = ( R1 * R1 ) / MomoFac1
1779 RR2 = ( R2 * R2 ) / MomoFac2
1780 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1781 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1782 fgb1 = sqrt( RR1 + a12sq * ee1 )
1783 fgb2 = sqrt( RR2 + a12sq * ee2 )
1784 epol = 332.0d0 * eps_inout_fac * (
1785 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1787 c! derivative of Epol is Gpol...
1788 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1790 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1792 dFGBdR1 = ( (R1 / MomoFac1)
1793 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1794 & / ( 2.0d0 * fgb1 )
1795 dFGBdR2 = ( (R2 / MomoFac2)
1796 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1797 & / ( 2.0d0 * fgb2 )
1798 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1799 & * ( 2.0d0 - 0.5d0 * ee1) )
1800 & / ( 2.0d0 * fgb1 )
1801 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1802 & * ( 2.0d0 - 0.5d0 * ee2) )
1803 & / ( 2.0d0 * fgb2 )
1804 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1806 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1808 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1810 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1812 c!-------------------------------------------------------------------
1814 pom = (pis / Rhead)**6.0d0
1815 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1817 c! derivative of Elj is Glj
1818 dGLJdR = 4.0d0 * eps_head
1819 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1820 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1822 c!-------------------------------------------------------------------
1824 IF (Wqd.ne.0.0d0) THEN
1825 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0)
1826 & - 37.5d0 * ( sqom1 + sqom2 )
1827 & + 157.5d0 * ( sqom1 * sqom2 )
1828 & - 45.0d0 * om1*om2*om12
1829 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
1832 c! derivative of Equad...
1833 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
1836 & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
1837 c! dQUADdOM1 = 0.0d0
1839 & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
1840 c! dQUADdOM2 = 0.0d0
1842 & * ( 6.0d0*om12 - 45.0d0*om1*om2 )
1843 c! dQUADdOM12 = 0.0d0
1848 c!-------------------------------------------------------------------
1849 c! Return the results
1851 eom1 = dPOLdOM1 + dQUADdOM1
1852 eom2 = dPOLdOM2 + dQUADdOM2
1854 c! now some magical transformations to project gradient into
1855 c! three cartesian vectors
1857 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1858 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1859 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
1863 erhead(k) = Rhead_distance(k)/Rhead
1864 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1865 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1867 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1868 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1869 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1870 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1871 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1872 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1873 facd1 = d1 * vbld_inv(i+nres)
1874 facd2 = d2 * vbld_inv(j+nres)
1875 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1876 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1877 c! Throw the results into gheadtail which holds gradients
1878 c! for each micro-state
1880 hawk = erhead_tail(k,1) +
1881 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
1882 condor = erhead_tail(k,2) +
1883 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
1885 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1886 c! this acts on hydrophobic center of interaction
1887 gheadtail(k,1,1) = gheadtail(k,1,1)
1892 & - dPOLdR2 * (erhead_tail(k,2)
1893 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1897 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1898 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1900 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1901 c! this acts on hydrophobic center of interaction
1902 gheadtail(k,2,1) = gheadtail(k,2,1)
1906 & + dPOLdR1 * (erhead_tail(k,1)
1907 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1908 & + dPOLdR2 * condor
1912 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1913 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1915 c! this acts on Calpha
1916 gheadtail(k,3,1) = gheadtail(k,3,1)
1917 & - dGCLdR * erhead(k)
1918 & - dGGBdR * erhead(k)
1919 & - dGCVdR * erhead(k)
1920 & - dPOLdR1 * erhead_tail(k,1)
1921 & - dPOLdR2 * erhead_tail(k,2)
1922 & - dGLJdR * erhead(k)
1923 & - dQUADdR * erhead(k)
1926 c! this acts on Calpha
1927 gheadtail(k,4,1) = gheadtail(k,4,1)
1928 & + dGCLdR * erhead(k)
1929 & + dGGBdR * erhead(k)
1930 & + dGCVdR * erhead(k)
1931 & + dPOLdR1 * erhead_tail(k,1)
1932 & + dPOLdR2 * erhead_tail(k,2)
1933 & + dGLJdR * erhead(k)
1934 & + dQUADdR * erhead(k)
1937 c! write(*,*) "ECL = ", Ecl
1938 c! write(*,*) "Egb = ", Egb
1939 c! write(*,*) "Epol = ", Epol
1940 c! write(*,*) "Fisocav = ", Fisocav
1941 c! write(*,*) "Elj = ", Elj
1942 c! write(*,*) "Equad = ", Equad
1943 c! write(*,*) "wstate = ", wstate(istate,itypi,itypj)
1944 c! write(*,*) "eheadtail = ", eheadtail
1945 c! write(*,*) "TROLL = ", dexp(-betaTT * ener(istate))
1946 c! write(*,*) "dGCLdR = ", dGCLdR
1947 c! write(*,*) "dGGBdR = ", dGGBdR
1948 c! write(*,*) "dGCVdR = ", dGCVdR
1949 c! write(*,*) "dPOLdR1 = ", dPOLdR1
1950 c! write(*,*) "dPOLdR2 = ", dPOLdR2
1951 c! write(*,*) "dGLJdR = ", dGLJdR
1952 c! write(*,*) "dQUADdR = ", dQUADdR
1953 c! write(*,*) "tuna(",k,") = ", tuna(k)
1954 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
1955 eheadtail = eheadtail
1956 & + wstate(istate, itypi, itypj)
1957 & * dexp(-betaTT * ener(istate))
1958 c! foreach cartesian dimension
1960 c! foreach of two gvdwx and gvdwc
1962 gheadtail(k,l,2) = gheadtail(k,l,2)
1963 & + wstate( istate, itypi, itypj )
1964 & * dexp(-betaTT * ener(istate))
1965 & * gheadtail(k,l,1)
1966 gheadtail(k,l,1) = 0.0d0
1970 c! Here ended the gigantic DO istate = 1, 4, which starts
1971 c! at the beggining of the subroutine
1975 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
1977 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
1978 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
1979 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
1980 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
1982 gheadtail(k,l,1) = 0.0d0
1983 gheadtail(k,l,2) = 0.0d0
1986 eheadtail = (-dlog(eheadtail)) / betaTT
1993 END SUBROUTINE energy_quad
1996 c!-------------------------------------------------------------------
1999 SUBROUTINE eqn(Epol)
2001 INCLUDE 'DIMENSIONS'
2002 INCLUDE 'sizesclu.dat'
2003 INCLUDE 'COMMON.CALC'
2004 INCLUDE 'COMMON.CHAIN'
2005 INCLUDE 'COMMON.CONTROL'
2006 INCLUDE 'COMMON.DERIV'
2007 INCLUDE 'COMMON.EMP'
2008 INCLUDE 'COMMON.GEO'
2009 INCLUDE 'COMMON.INTERACT'
2010 INCLUDE 'COMMON.IOUNITS'
2011 INCLUDE 'COMMON.LOCAL'
2012 INCLUDE 'COMMON.NAMES'
2013 INCLUDE 'COMMON.VAR'
2014 double precision scalar, facd4, federmaus
2015 alphapol1 = alphapol(itypi,itypj)
2016 c! R1 - distance between head of ith side chain and tail of jth sidechain
2019 c! Calculate head-to-tail distances
2020 R1=R1+(ctail(k,2)-chead(k,1))**2
2025 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2026 c! & +dhead(1,1,itypi,itypj))**2))
2027 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2028 c! & +dhead(2,1,itypi,itypj))**2))
2029 c--------------------------------------------------------------------
2030 c Polarization energy
2032 MomoFac1 = (1.0d0 - chi1 * sqom2)
2033 RR1 = R1 * R1 / MomoFac1
2034 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2035 fgb1 = sqrt( RR1 + a12sq * ee1)
2036 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2038 c!------------------------------------------------------------------
2039 c! derivative of Epol is Gpol...
2040 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2042 dFGBdR1 = ( (R1 / MomoFac1)
2043 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2044 & / ( 2.0d0 * fgb1 )
2045 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2046 & * (2.0d0 - 0.5d0 * ee1) )
2048 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2051 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2053 c!-------------------------------------------------------------------
2054 c! Return the results
2055 c! (see comments in Eqq)
2057 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2059 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2060 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2061 facd1 = d1 * vbld_inv(i+nres)
2062 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2065 hawk = (erhead_tail(k,1) +
2066 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2068 gvdwx(k,i) = gvdwx(k,i)
2070 gvdwx(k,j) = gvdwx(k,j)
2071 & + dPOLdR1 * (erhead_tail(k,1)
2072 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2074 gvdwc(k,i) = gvdwc(k,i)
2075 & - dPOLdR1 * erhead_tail(k,1)
2076 gvdwc(k,j) = gvdwc(k,j)
2077 & + dPOLdR1 * erhead_tail(k,1)
2084 c!-------------------------------------------------------------------
2088 SUBROUTINE enq(Epol)
2090 INCLUDE 'DIMENSIONS'
2091 INCLUDE 'sizesclu.dat'
2092 INCLUDE 'COMMON.CALC'
2093 INCLUDE 'COMMON.CHAIN'
2094 INCLUDE 'COMMON.CONTROL'
2095 INCLUDE 'COMMON.DERIV'
2096 INCLUDE 'COMMON.EMP'
2097 INCLUDE 'COMMON.GEO'
2098 INCLUDE 'COMMON.INTERACT'
2099 INCLUDE 'COMMON.IOUNITS'
2100 INCLUDE 'COMMON.LOCAL'
2101 INCLUDE 'COMMON.NAMES'
2102 INCLUDE 'COMMON.VAR'
2103 double precision scalar, facd3, adler
2104 alphapol2 = alphapol(itypj,itypi)
2105 c! R2 - distance between head of jth side chain and tail of ith sidechain
2108 c! Calculate head-to-tail distances
2109 R2=R2+(chead(k,2)-ctail(k,1))**2
2114 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2115 c! & +dhead(1,1,itypi,itypj))**2))
2116 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2117 c! & +dhead(2,1,itypi,itypj))**2))
2118 c------------------------------------------------------------------------
2119 c Polarization energy
2120 MomoFac2 = (1.0d0 - chi2 * sqom1)
2121 RR2 = R2 * R2 / MomoFac2
2122 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2123 fgb2 = sqrt(RR2 + a12sq * ee2)
2124 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2126 c!-------------------------------------------------------------------
2127 c! derivative of Epol is Gpol...
2128 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2130 dFGBdR2 = ( (R2 / MomoFac2)
2131 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2133 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2134 & * (2.0d0 - 0.5d0 * ee2) )
2136 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2138 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2141 c!-------------------------------------------------------------------
2142 c! Return the results
2143 c! (See comments in Eqq)
2145 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2147 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2148 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2149 facd2 = d2 * vbld_inv(j+nres)
2150 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2152 condor = (erhead_tail(k,2)
2153 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2155 gvdwx(k,i) = gvdwx(k,i)
2156 & - dPOLdR2 * (erhead_tail(k,2)
2157 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2158 gvdwx(k,j) = gvdwx(k,j)
2159 & + dPOLdR2 * condor
2161 gvdwc(k,i) = gvdwc(k,i)
2162 & - dPOLdR2 * erhead_tail(k,2)
2163 gvdwc(k,j) = gvdwc(k,j)
2164 & + dPOLdR2 * erhead_tail(k,2)
2171 c!-------------------------------------------------------------------
2174 SUBROUTINE eqd(Ecl,Elj,Epol)
2176 INCLUDE 'DIMENSIONS'
2177 INCLUDE 'sizesclu.dat'
2178 INCLUDE 'COMMON.CALC'
2179 INCLUDE 'COMMON.CHAIN'
2180 INCLUDE 'COMMON.CONTROL'
2181 INCLUDE 'COMMON.DERIV'
2182 INCLUDE 'COMMON.EMP'
2183 INCLUDE 'COMMON.GEO'
2184 INCLUDE 'COMMON.INTERACT'
2185 INCLUDE 'COMMON.IOUNITS'
2186 INCLUDE 'COMMON.LOCAL'
2187 INCLUDE 'COMMON.NAMES'
2188 INCLUDE 'COMMON.VAR'
2189 double precision scalar, facd4, federmaus
2190 alphapol1 = alphapol(itypi,itypj)
2191 w1 = wqdip(1,itypi,itypj)
2192 w2 = wqdip(2,itypi,itypj)
2193 pis = sig0head(itypi,itypj)
2194 eps_head = epshead(itypi,itypj)
2195 c!-------------------------------------------------------------------
2196 c! R1 - distance between head of ith side chain and tail of jth sidechain
2199 c! Calculate head-to-tail distances
2200 R1=R1+(ctail(k,2)-chead(k,1))**2
2205 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2206 c! & +dhead(1,1,itypi,itypj))**2))
2207 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2208 c! & +dhead(2,1,itypi,itypj))**2))
2210 c!-------------------------------------------------------------------
2212 sparrow = w1 * Qi * om1
2213 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2214 Ecl = sparrow / Rhead**2.0d0
2215 & - hawk / Rhead**4.0d0
2216 c!-------------------------------------------------------------------
2217 c! derivative of ecl is Gcl
2219 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2220 & + 4.0d0 * hawk / Rhead**5.0d0
2222 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2224 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2225 c--------------------------------------------------------------------
2226 c Polarization energy
2228 MomoFac1 = (1.0d0 - chi1 * sqom2)
2229 RR1 = R1 * R1 / MomoFac1
2230 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2231 fgb1 = sqrt( RR1 + a12sq * ee1)
2232 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2234 c!------------------------------------------------------------------
2235 c! derivative of Epol is Gpol...
2236 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2238 dFGBdR1 = ( (R1 / MomoFac1)
2239 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2240 & / ( 2.0d0 * fgb1 )
2241 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2242 & * (2.0d0 - 0.5d0 * ee1) )
2244 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2247 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2249 c!-------------------------------------------------------------------
2251 pom = (pis / Rhead)**6.0d0
2252 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2253 c! derivative of Elj is Glj
2254 dGLJdR = 4.0d0 * eps_head
2255 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2256 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2257 c!-------------------------------------------------------------------
2258 c! Return the results
2260 erhead(k) = Rhead_distance(k)/Rhead
2261 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2264 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2265 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2266 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2267 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2268 facd1 = d1 * vbld_inv(i+nres)
2269 facd2 = d2 * vbld_inv(j+nres)
2270 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2273 hawk = (erhead_tail(k,1) +
2274 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2276 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2277 gvdwx(k,i) = gvdwx(k,i)
2282 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2283 gvdwx(k,j) = gvdwx(k,j)
2285 & + dPOLdR1 * (erhead_tail(k,1)
2286 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2290 gvdwc(k,i) = gvdwc(k,i)
2291 & - dGCLdR * erhead(k)
2292 & - dPOLdR1 * erhead_tail(k,1)
2293 & - dGLJdR * erhead(k)
2295 gvdwc(k,j) = gvdwc(k,j)
2296 & + dGCLdR * erhead(k)
2297 & + dPOLdR1 * erhead_tail(k,1)
2298 & + dGLJdR * erhead(k)
2305 c!-------------------------------------------------------------------
2308 SUBROUTINE edq(Ecl,Elj,Epol)
2310 INCLUDE 'DIMENSIONS'
2311 INCLUDE 'sizesclu.dat'
2312 INCLUDE 'COMMON.CALC'
2313 INCLUDE 'COMMON.CHAIN'
2314 INCLUDE 'COMMON.CONTROL'
2315 INCLUDE 'COMMON.DERIV'
2316 INCLUDE 'COMMON.EMP'
2317 INCLUDE 'COMMON.GEO'
2318 INCLUDE 'COMMON.INTERACT'
2319 INCLUDE 'COMMON.IOUNITS'
2320 INCLUDE 'COMMON.LOCAL'
2321 INCLUDE 'COMMON.NAMES'
2322 INCLUDE 'COMMON.VAR'
2323 double precision scalar, facd3, adler
2324 alphapol2 = alphapol(itypj,itypi)
2325 w1 = wqdip(1,itypi,itypj)
2326 w2 = wqdip(2,itypi,itypj)
2327 pis = sig0head(itypi,itypj)
2328 eps_head = epshead(itypi,itypj)
2329 c!-------------------------------------------------------------------
2330 c! R2 - distance between head of jth side chain and tail of ith sidechain
2333 c! Calculate head-to-tail distances
2334 R2=R2+(chead(k,2)-ctail(k,1))**2
2339 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2340 c! & +dhead(1,1,itypi,itypj))**2))
2341 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2342 c! & +dhead(2,1,itypi,itypj))**2))
2345 c!-------------------------------------------------------------------
2347 sparrow = w1 * Qi * om1
2348 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2349 ECL = sparrow / Rhead**2.0d0
2350 & - hawk / Rhead**4.0d0
2351 c!-------------------------------------------------------------------
2352 c! derivative of ecl is Gcl
2354 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2355 & + 4.0d0 * hawk / Rhead**5.0d0
2357 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2359 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2360 c--------------------------------------------------------------------
2361 c Polarization energy
2363 MomoFac2 = (1.0d0 - chi2 * sqom1)
2364 RR2 = R2 * R2 / MomoFac2
2365 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2366 fgb2 = sqrt(RR2 + a12sq * ee2)
2367 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2369 c! derivative of Epol is Gpol...
2370 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2372 dFGBdR2 = ( (R2 / MomoFac2)
2373 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2375 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2376 & * (2.0d0 - 0.5d0 * ee2) )
2378 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2380 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2383 c!-------------------------------------------------------------------
2385 pom = (pis / Rhead)**6.0d0
2386 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2387 c! derivative of Elj is Glj
2388 dGLJdR = 4.0d0 * eps_head
2389 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2390 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2391 c!-------------------------------------------------------------------
2392 c! Return the results
2393 c! (see comments in Eqq)
2395 erhead(k) = Rhead_distance(k)/Rhead
2396 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2398 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2399 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2400 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2401 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2402 facd1 = d1 * vbld_inv(i+nres)
2403 facd2 = d2 * vbld_inv(j+nres)
2404 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2407 condor = (erhead_tail(k,2)
2408 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2410 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2411 gvdwx(k,i) = gvdwx(k,i)
2413 & - dPOLdR2 * (erhead_tail(k,2)
2414 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2417 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2418 gvdwx(k,j) = gvdwx(k,j)
2420 & + dPOLdR2 * condor
2424 gvdwc(k,i) = gvdwc(k,i)
2425 & - dGCLdR * erhead(k)
2426 & - dPOLdR2 * erhead_tail(k,2)
2427 & - dGLJdR * erhead(k)
2429 gvdwc(k,j) = gvdwc(k,j)
2430 & + dGCLdR * erhead(k)
2431 & + dPOLdR2 * erhead_tail(k,2)
2432 & + dGLJdR * erhead(k)
2439 C--------------------------------------------------------------------
2444 INCLUDE 'DIMENSIONS'
2445 INCLUDE 'sizesclu.dat'
2446 INCLUDE 'COMMON.CALC'
2447 INCLUDE 'COMMON.CHAIN'
2448 INCLUDE 'COMMON.CONTROL'
2449 INCLUDE 'COMMON.DERIV'
2450 INCLUDE 'COMMON.EMP'
2451 INCLUDE 'COMMON.GEO'
2452 INCLUDE 'COMMON.INTERACT'
2453 INCLUDE 'COMMON.IOUNITS'
2454 INCLUDE 'COMMON.LOCAL'
2455 INCLUDE 'COMMON.NAMES'
2456 INCLUDE 'COMMON.VAR'
2457 double precision scalar
2458 c! csig = sigiso(itypi,itypj)
2459 w1 = wqdip(1,itypi,itypj)
2460 w2 = wqdip(2,itypi,itypj)
2461 c!-------------------------------------------------------------------
2463 fac = (om12 - 3.0d0 * om1 * om2)
2464 c1 = (w1 / (Rhead**3.0d0)) * fac
2465 c2 = (w2 / Rhead ** 6.0d0)
2466 & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2468 c! write (*,*) "w1 = ", w1
2469 c! write (*,*) "w2 = ", w2
2470 c! write (*,*) "om1 = ", om1
2471 c! write (*,*) "om2 = ", om2
2472 c! write (*,*) "om12 = ", om12
2473 c! write (*,*) "fac = ", fac
2474 c! write (*,*) "c1 = ", c1
2475 c! write (*,*) "c2 = ", c2
2476 c! write (*,*) "Ecl = ", Ecl
2477 c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
2478 c! write (*,*) "c2_2 = ",
2479 c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2480 c!-------------------------------------------------------------------
2481 c! dervative of ECL is GCL...
2483 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
2484 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0)
2485 & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
2488 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
2489 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2490 & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
2493 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
2494 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2495 & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
2498 c1 = w1 / (Rhead ** 3.0d0)
2499 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
2501 c!-------------------------------------------------------------------
2502 c! Return the results
2503 c! (see comments in Eqq)
2505 erhead(k) = Rhead_distance(k)/Rhead
2507 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2508 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2509 facd1 = d1 * vbld_inv(i+nres)
2510 facd2 = d2 * vbld_inv(j+nres)
2513 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2514 gvdwx(k,i) = gvdwx(k,i)
2516 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2517 gvdwx(k,j) = gvdwx(k,j)
2520 gvdwc(k,i) = gvdwc(k,i)
2521 & - dGCLdR * erhead(k)
2522 gvdwc(k,j) = gvdwc(k,j)
2523 & + dGCLdR * erhead(k)
2529 c!-------------------------------------------------------------------
2532 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
2535 INCLUDE 'DIMENSIONS'
2536 INCLUDE 'sizesclu.dat'
2537 c! itypi, itypj, i, j, k, l, chead,
2538 INCLUDE 'COMMON.CALC'
2540 INCLUDE 'COMMON.CHAIN'
2542 INCLUDE 'COMMON.DERIV'
2543 c! electrostatic gradients-specific variables
2544 INCLUDE 'COMMON.EMP'
2545 c! wquad, dhead, alphiso, alphasur, rborn, epsintab
2546 INCLUDE 'COMMON.INTERACT'
2547 c! io for debug, disable it in final builds
2548 INCLUDE 'COMMON.IOUNITS'
2549 c!-------------------------------------------------------------------
2552 c! what amino acid is the aminoacid j'th?
2554 c! 1/(Gas Constant * Thermostate temperature) = BetaTT
2555 c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
2556 BetaTT = 1.0d0 / (298 * 1.987d-3)
2558 sig0ij = sigma( itypi,itypj )
2559 chi1 = chi( itypi, itypj )
2560 chi2 = chi( itypj, itypi )
2562 chip1 = chipp( itypi, itypj )
2563 chip2 = chipp( itypj, itypi )
2564 chip12 = chip1 * chip2
2565 c! write (2,*) "elgrad types",itypi,itypj,
2566 c! & " chi1",chi1," chi2",chi2," chi12",chi12,
2567 c! & " chip1",chip1," chip2",chip2," chip12",chip12
2568 c! not used by momo potential, but needed by sc_angular which is shared
2569 c! by all energy_potential subroutines
2573 c! location, location, location
2574 xj = c( 1, nres+j ) - xi
2575 yj = c( 2, nres+j ) - yi
2576 zj = c( 3, nres+j ) - zi
2577 dxj = dc_norm( 1, nres+j )
2578 dyj = dc_norm( 2, nres+j )
2579 dzj = dc_norm( 3, nres+j )
2580 c! distance from center of chain(?) to polar/charged head
2581 c! write (*,*) "istate = ", 1
2582 c! write (*,*) "ii = ", 1
2583 c! write (*,*) "jj = ", 1
2584 d1 = dhead(1, 1, itypi, itypj)
2585 d2 = dhead(2, 1, itypi, itypj)
2587 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
2588 c! a12sq = a12sq * a12sq
2589 c! charge of amino acid itypi is...
2594 chis1 = chis(itypi,itypj)
2595 chis2 = chis(itypj,itypi)
2596 chis12 = chis1 * chis2
2597 sig1 = sigmap1(itypi,itypj)
2598 sig2 = sigmap2(itypi,itypj)
2599 c! write (*,*) "sig1 = ", sig1
2600 c! write (*,*) "sig2 = ", sig2
2601 c! alpha factors from Fcav/Gcav
2602 b1 = alphasur(1,itypi,itypj)
2603 b2 = alphasur(2,itypi,itypj)
2604 b3 = alphasur(3,itypi,itypj)
2605 b4 = alphasur(4,itypi,itypj)
2606 c! used to determine whether we want to do quadrupole calculations
2607 wqd = wquad(itypi, itypj)
2609 eps_in = epsintab(itypi,itypj)
2610 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
2611 c! write (*,*) "eps_inout_fac = ", eps_inout_fac
2612 c!-------------------------------------------------------------------
2613 c! tail location and distance calculations
2616 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
2617 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
2619 c! tail distances will be themselves usefull elswhere
2620 c1 (in Gcav, for example)
2621 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
2622 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
2623 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
2625 & (Rtail_distance(1)*Rtail_distance(1))
2626 & + (Rtail_distance(2)*Rtail_distance(2))
2627 & + (Rtail_distance(3)*Rtail_distance(3)))
2628 c!-------------------------------------------------------------------
2629 c! Calculate location and distance between polar heads
2630 c! distance between heads
2631 c! for each one of our three dimensional space...
2633 c! location of polar head is computed by taking hydrophobic centre
2634 c! and moving by a d1 * dc_norm vector
2635 c! see unres publications for very informative images
2636 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
2637 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
2639 c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
2640 c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
2641 Rhead_distance(k) = chead(k,2) - chead(k,1)
2643 c! pitagoras (root of sum of squares)
2645 & (Rhead_distance(1)*Rhead_distance(1))
2646 & + (Rhead_distance(2)*Rhead_distance(2))
2647 & + (Rhead_distance(3)*Rhead_distance(3)))
2648 c!-------------------------------------------------------------------
2649 c! zero everything that should be zero'ed
2662 END SUBROUTINE elgrad_init
2663 c!-------------------------------------------------------------------
2664 subroutine sc_angular
2665 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2666 C om12. Called by ebp, egb, and egbv.
2668 include 'COMMON.CALC'
2669 include 'COMMON.IOUNITS'
2673 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2674 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2675 om12=dxi*dxj+dyi*dyj+dzi*dzj
2680 C Calculate eps1(om12) and its derivative in om12
2681 faceps1=1.0D0-om12*chiom12
2682 faceps1_inv=1.0D0/faceps1
2683 eps1=dsqrt(faceps1_inv)
2684 c write (2,*) "chi1",chi1," chi2",chi2," chi12",chi12
2685 c write (2,*) "fsceps1",faceps1," faceps1_inv",faceps1_inv,
2687 C Following variable is eps1*deps1/dom12
2688 eps1_om12=faceps1_inv*chiom12
2693 c write (iout,*) "om12",om12," eps1",eps1
2694 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2699 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2700 sigsq=1.0D0-facsig*faceps1_inv
2701 c write (2,*) "om1",om1," om2",om2," om1om2",om1om2,
2702 c & " chiom1",chiom1,
2703 c & " chiom2",chiom2," facsig",facsig," sigsq",sigsq
2704 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2705 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2706 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2712 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2713 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2715 C Calculate eps2 and its derivatives in om1, om2, and om12.
2718 chipom12=chip12*om12
2719 facp=1.0D0-om12*chipom12
2721 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2722 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2723 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2724 C Following variable is the square root of eps2
2725 eps2rt=1.0D0-facp1*facp_inv
2726 C Following three variables are the derivatives of the square root of eps
2727 C in om1, om2, and om12.
2728 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2729 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2730 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2731 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2732 c! Note that THIS is 0 in emomo, so we should probably move it out of sc_angular
2733 c! Or frankly, we should restructurize the whole energy section
2734 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2735 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2736 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2737 c & " eps2rt_om12",eps2rt_om12
2738 C Calculate whole angle-dependent part of epsilon and contributions
2739 C to its derivatives
2742 C----------------------------------------------------------------------------
2743 C----------------------------------------------------------------------------
2745 implicit real*8 (a-h,o-z)
2746 include 'DIMENSIONS'
2747 include 'sizesclu.dat'
2748 include 'COMMON.CHAIN'
2749 include 'COMMON.DERIV'
2750 include 'COMMON.CALC'
2751 double precision dcosom1(3),dcosom2(3)
2752 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2753 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2754 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2755 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2757 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2758 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2761 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2764 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2765 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2766 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2767 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2768 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2769 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2772 C Calculate the components of the gradient in DC and X
2776 gvdwc(l,k)=gvdwc(l,k)+gg(l)
2781 c------------------------------------------------------------------------------
2782 subroutine vec_and_deriv
2783 implicit real*8 (a-h,o-z)
2784 include 'DIMENSIONS'
2785 include 'sizesclu.dat'
2786 include 'COMMON.IOUNITS'
2787 include 'COMMON.GEO'
2788 include 'COMMON.VAR'
2789 include 'COMMON.LOCAL'
2790 include 'COMMON.CHAIN'
2791 include 'COMMON.VECTORS'
2792 include 'COMMON.DERIV'
2793 include 'COMMON.INTERACT'
2794 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2795 C Compute the local reference systems. For reference system (i), the
2796 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2797 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2799 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
2800 if (i.eq.nres-1) then
2801 C Case of the last full residue
2802 C Compute the Z-axis
2803 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2804 costh=dcos(pi-theta(nres))
2805 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2810 C Compute the derivatives of uz
2812 uzder(2,1,1)=-dc_norm(3,i-1)
2813 uzder(3,1,1)= dc_norm(2,i-1)
2814 uzder(1,2,1)= dc_norm(3,i-1)
2816 uzder(3,2,1)=-dc_norm(1,i-1)
2817 uzder(1,3,1)=-dc_norm(2,i-1)
2818 uzder(2,3,1)= dc_norm(1,i-1)
2821 uzder(2,1,2)= dc_norm(3,i)
2822 uzder(3,1,2)=-dc_norm(2,i)
2823 uzder(1,2,2)=-dc_norm(3,i)
2825 uzder(3,2,2)= dc_norm(1,i)
2826 uzder(1,3,2)= dc_norm(2,i)
2827 uzder(2,3,2)=-dc_norm(1,i)
2830 C Compute the Y-axis
2833 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2836 C Compute the derivatives of uy
2839 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2840 & -dc_norm(k,i)*dc_norm(j,i-1)
2841 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2843 uyder(j,j,1)=uyder(j,j,1)-costh
2844 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2849 uygrad(l,k,j,i)=uyder(l,k,j)
2850 uzgrad(l,k,j,i)=uzder(l,k,j)
2854 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2855 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2856 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2857 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2861 C Compute the Z-axis
2862 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2863 costh=dcos(pi-theta(i+2))
2864 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2869 C Compute the derivatives of uz
2871 uzder(2,1,1)=-dc_norm(3,i+1)
2872 uzder(3,1,1)= dc_norm(2,i+1)
2873 uzder(1,2,1)= dc_norm(3,i+1)
2875 uzder(3,2,1)=-dc_norm(1,i+1)
2876 uzder(1,3,1)=-dc_norm(2,i+1)
2877 uzder(2,3,1)= dc_norm(1,i+1)
2880 uzder(2,1,2)= dc_norm(3,i)
2881 uzder(3,1,2)=-dc_norm(2,i)
2882 uzder(1,2,2)=-dc_norm(3,i)
2884 uzder(3,2,2)= dc_norm(1,i)
2885 uzder(1,3,2)= dc_norm(2,i)
2886 uzder(2,3,2)=-dc_norm(1,i)
2889 C Compute the Y-axis
2892 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2895 C Compute the derivatives of uy
2898 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2899 & -dc_norm(k,i)*dc_norm(j,i+1)
2900 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2902 uyder(j,j,1)=uyder(j,j,1)-costh
2903 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2908 uygrad(l,k,j,i)=uyder(l,k,j)
2909 uzgrad(l,k,j,i)=uzder(l,k,j)
2913 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2914 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2915 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2916 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2922 vbld_inv_temp(1)=vbld_inv(i+1)
2923 if (i.lt.nres-1) then
2924 vbld_inv_temp(2)=vbld_inv(i+2)
2926 vbld_inv_temp(2)=vbld_inv(i)
2931 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2932 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2940 C-----------------------------------------------------------------------------
2941 subroutine vec_and_deriv_test
2942 implicit real*8 (a-h,o-z)
2943 include 'DIMENSIONS'
2944 include 'sizesclu.dat'
2945 include 'COMMON.IOUNITS'
2946 include 'COMMON.GEO'
2947 include 'COMMON.VAR'
2948 include 'COMMON.LOCAL'
2949 include 'COMMON.CHAIN'
2950 include 'COMMON.VECTORS'
2951 dimension uyder(3,3,2),uzder(3,3,2)
2952 C Compute the local reference systems. For reference system (i), the
2953 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2954 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2956 if (i.eq.nres-1) then
2957 C Case of the last full residue
2958 C Compute the Z-axis
2959 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2960 costh=dcos(pi-theta(nres))
2961 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2962 c write (iout,*) 'fac',fac,
2963 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
2964 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
2968 C Compute the derivatives of uz
2970 uzder(2,1,1)=-dc_norm(3,i-1)
2971 uzder(3,1,1)= dc_norm(2,i-1)
2972 uzder(1,2,1)= dc_norm(3,i-1)
2974 uzder(3,2,1)=-dc_norm(1,i-1)
2975 uzder(1,3,1)=-dc_norm(2,i-1)
2976 uzder(2,3,1)= dc_norm(1,i-1)
2979 uzder(2,1,2)= dc_norm(3,i)
2980 uzder(3,1,2)=-dc_norm(2,i)
2981 uzder(1,2,2)=-dc_norm(3,i)
2983 uzder(3,2,2)= dc_norm(1,i)
2984 uzder(1,3,2)= dc_norm(2,i)
2985 uzder(2,3,2)=-dc_norm(1,i)
2987 C Compute the Y-axis
2989 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2992 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
2993 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
2994 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
2996 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2999 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
3000 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
3003 c write (iout,*) 'facy',facy,
3004 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3005 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3007 uy(k,i)=facy*uy(k,i)
3009 C Compute the derivatives of uy
3012 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
3013 & -dc_norm(k,i)*dc_norm(j,i-1)
3014 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3016 c uyder(j,j,1)=uyder(j,j,1)-costh
3017 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
3018 uyder(j,j,1)=uyder(j,j,1)
3019 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
3020 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
3026 uygrad(l,k,j,i)=uyder(l,k,j)
3027 uzgrad(l,k,j,i)=uzder(l,k,j)
3031 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3032 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3033 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3034 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3037 C Compute the Z-axis
3038 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
3039 costh=dcos(pi-theta(i+2))
3040 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3041 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
3045 C Compute the derivatives of uz
3047 uzder(2,1,1)=-dc_norm(3,i+1)
3048 uzder(3,1,1)= dc_norm(2,i+1)
3049 uzder(1,2,1)= dc_norm(3,i+1)
3051 uzder(3,2,1)=-dc_norm(1,i+1)
3052 uzder(1,3,1)=-dc_norm(2,i+1)
3053 uzder(2,3,1)= dc_norm(1,i+1)
3056 uzder(2,1,2)= dc_norm(3,i)
3057 uzder(3,1,2)=-dc_norm(2,i)
3058 uzder(1,2,2)=-dc_norm(3,i)
3060 uzder(3,2,2)= dc_norm(1,i)
3061 uzder(1,3,2)= dc_norm(2,i)
3062 uzder(2,3,2)=-dc_norm(1,i)
3064 C Compute the Y-axis
3066 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
3067 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
3068 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
3070 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
3073 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
3074 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
3077 c write (iout,*) 'facy',facy,
3078 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3079 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3081 uy(k,i)=facy*uy(k,i)
3083 C Compute the derivatives of uy
3086 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
3087 & -dc_norm(k,i)*dc_norm(j,i+1)
3088 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3090 c uyder(j,j,1)=uyder(j,j,1)-costh
3091 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
3092 uyder(j,j,1)=uyder(j,j,1)
3093 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
3094 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
3100 uygrad(l,k,j,i)=uyder(l,k,j)
3101 uzgrad(l,k,j,i)=uzder(l,k,j)
3105 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3106 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3107 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3108 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3115 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
3116 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
3123 C-----------------------------------------------------------------------------
3124 subroutine check_vecgrad
3125 implicit real*8 (a-h,o-z)
3126 include 'DIMENSIONS'
3127 include 'sizesclu.dat'
3128 include 'COMMON.IOUNITS'
3129 include 'COMMON.GEO'
3130 include 'COMMON.VAR'
3131 include 'COMMON.LOCAL'
3132 include 'COMMON.CHAIN'
3133 include 'COMMON.VECTORS'
3134 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
3135 dimension uyt(3,maxres),uzt(3,maxres)
3136 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
3137 double precision delta /1.0d-7/
3140 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
3141 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
3142 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
3143 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
3144 cd & (dc_norm(if90,i),if90=1,3)
3145 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
3146 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
3147 cd write(iout,'(a)')
3153 uygradt(l,k,j,i)=uygrad(l,k,j,i)
3154 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
3167 cd write (iout,*) 'i=',i
3169 erij(k)=dc_norm(k,i)
3173 dc_norm(k,i)=erij(k)
3175 dc_norm(j,i)=dc_norm(j,i)+delta
3176 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
3178 c dc_norm(k,i)=dc_norm(k,i)/fac
3180 c write (iout,*) (dc_norm(k,i),k=1,3)
3181 c write (iout,*) (erij(k),k=1,3)
3184 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
3185 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
3186 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
3187 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
3189 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3190 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
3191 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
3194 dc_norm(k,i)=erij(k)
3197 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3198 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
3199 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
3200 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3201 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
3202 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
3203 cd write (iout,'(a)')
3208 C--------------------------------------------------------------------------
3209 subroutine set_matrices
3210 implicit real*8 (a-h,o-z)
3211 include 'DIMENSIONS'
3212 include 'sizesclu.dat'
3213 include 'COMMON.IOUNITS'
3214 include 'COMMON.GEO'
3215 include 'COMMON.VAR'
3216 include 'COMMON.LOCAL'
3217 include 'COMMON.CHAIN'
3218 include 'COMMON.DERIV'
3219 include 'COMMON.INTERACT'
3220 include 'COMMON.CONTACTS'
3221 include 'COMMON.TORSION'
3222 include 'COMMON.VECTORS'
3223 include 'COMMON.FFIELD'
3224 double precision auxvec(2),auxmat(2,2)
3226 C Compute the virtual-bond-torsional-angle dependent quantities needed
3227 C to calculate the el-loc multibody terms of various order.
3230 if (i .lt. nres+1) then
3267 if (i .gt. 3 .and. i .lt. nres+1) then
3268 obrot_der(1,i-2)=-sin1
3269 obrot_der(2,i-2)= cos1
3270 Ugder(1,1,i-2)= sin1
3271 Ugder(1,2,i-2)=-cos1
3272 Ugder(2,1,i-2)=-cos1
3273 Ugder(2,2,i-2)=-sin1
3276 obrot2_der(1,i-2)=-dwasin2
3277 obrot2_der(2,i-2)= dwacos2
3278 Ug2der(1,1,i-2)= dwasin2
3279 Ug2der(1,2,i-2)=-dwacos2
3280 Ug2der(2,1,i-2)=-dwacos2
3281 Ug2der(2,2,i-2)=-dwasin2
3283 obrot_der(1,i-2)=0.0d0
3284 obrot_der(2,i-2)=0.0d0
3285 Ugder(1,1,i-2)=0.0d0
3286 Ugder(1,2,i-2)=0.0d0
3287 Ugder(2,1,i-2)=0.0d0
3288 Ugder(2,2,i-2)=0.0d0
3289 obrot2_der(1,i-2)=0.0d0
3290 obrot2_der(2,i-2)=0.0d0
3291 Ug2der(1,1,i-2)=0.0d0
3292 Ug2der(1,2,i-2)=0.0d0
3293 Ug2der(2,1,i-2)=0.0d0
3294 Ug2der(2,2,i-2)=0.0d0
3296 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
3297 iti = itortyp(itype(i-2))
3301 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3302 iti1 = itortyp(itype(i-1))
3306 cd write (iout,*) '*******i',i,' iti1',iti
3307 cd write (iout,*) 'b1',b1(:,iti)
3308 cd write (iout,*) 'b2',b2(:,iti)
3309 cd write (iout,*) 'Ug',Ug(:,:,i-2)
3310 if (i .gt. iatel_s+2) then
3311 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
3312 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
3313 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
3314 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
3315 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3316 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
3317 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
3327 DtUg2(l,k,i-2)=0.0d0
3331 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
3332 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
3333 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3334 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3335 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3336 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3337 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3339 muder(k,i-2)=Ub2der(k,i-2)
3341 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3342 iti1 = itortyp(itype(i-1))
3347 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
3349 C Vectors and matrices dependent on a single virtual-bond dihedral.
3350 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
3351 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3352 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3353 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3354 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3355 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3356 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3357 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3358 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3359 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
3360 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
3362 C Matrices dependent on two consecutive virtual-bond dihedrals.
3363 C The order of matrices is from left to right.
3365 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3366 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3367 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3368 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3369 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3370 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3371 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3372 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3375 cd iti = itortyp(itype(i))
3378 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3379 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3384 C--------------------------------------------------------------------------
3385 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3387 C This subroutine calculates the average interaction energy and its gradient
3388 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3389 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3390 C The potential depends both on the distance of peptide-group centers and on
3391 C the orientation of the CA-CA virtual bonds.
3393 implicit real*8 (a-h,o-z)
3394 include 'DIMENSIONS'
3395 include 'sizesclu.dat'
3396 include 'COMMON.CONTROL'
3397 include 'COMMON.IOUNITS'
3398 include 'COMMON.GEO'
3399 include 'COMMON.VAR'
3400 include 'COMMON.LOCAL'
3401 include 'COMMON.CHAIN'
3402 include 'COMMON.DERIV'
3403 include 'COMMON.INTERACT'
3404 include 'COMMON.CONTACTS'
3405 include 'COMMON.TORSION'
3406 include 'COMMON.VECTORS'
3407 include 'COMMON.FFIELD'
3408 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3409 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3410 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3411 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3412 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
3413 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3414 double precision scal_el /0.5d0/
3416 C 13-go grudnia roku pamietnego...
3417 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3418 & 0.0d0,1.0d0,0.0d0,
3419 & 0.0d0,0.0d0,1.0d0/
3420 cd write(iout,*) 'In EELEC'
3422 cd write(iout,*) 'Type',i
3423 cd write(iout,*) 'B1',B1(:,i)
3424 cd write(iout,*) 'B2',B2(:,i)
3425 cd write(iout,*) 'CC',CC(:,:,i)
3426 cd write(iout,*) 'DD',DD(:,:,i)
3427 cd write(iout,*) 'EE',EE(:,:,i)
3429 cd call check_vecgrad
3431 if (icheckgrad.eq.1) then
3433 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3435 dc_norm(k,i)=dc(k,i)*fac
3437 c write (iout,*) 'i',i,' fac',fac
3440 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3441 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3442 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3443 cd if (wel_loc.gt.0.0d0) then
3444 if (icheckgrad.eq.1) then
3445 call vec_and_deriv_test
3452 cd write (iout,*) 'i=',i
3454 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3457 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3458 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3471 cd print '(a)','Enter EELEC'
3472 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3474 gel_loc_loc(i)=0.0d0
3477 do i=iatel_s,iatel_e
3478 if (itel(i).eq.0) goto 1215
3482 dx_normi=dc_norm(1,i)
3483 dy_normi=dc_norm(2,i)
3484 dz_normi=dc_norm(3,i)
3485 xmedi=c(1,i)+0.5d0*dxi
3486 ymedi=c(2,i)+0.5d0*dyi
3487 zmedi=c(3,i)+0.5d0*dzi
3489 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3490 do j=ielstart(i),ielend(i)
3491 if (itel(j).eq.0) goto 1216
3495 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3496 aaa=app(iteli,itelj)
3497 bbb=bpp(iteli,itelj)
3498 C Diagnostics only!!!
3504 ael6i=ael6(iteli,itelj)
3505 ael3i=ael3(iteli,itelj)
3509 dx_normj=dc_norm(1,j)
3510 dy_normj=dc_norm(2,j)
3511 dz_normj=dc_norm(3,j)
3512 xj=c(1,j)+0.5D0*dxj-xmedi
3513 yj=c(2,j)+0.5D0*dyj-ymedi
3514 zj=c(3,j)+0.5D0*dzj-zmedi
3515 rij=xj*xj+yj*yj+zj*zj
3521 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3522 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3523 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3524 fac=cosa-3.0D0*cosb*cosg
3526 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3527 if (j.eq.i+2) ev1=scal_el*ev1
3532 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3535 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
3536 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3537 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3540 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3541 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3542 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3543 cd & xmedi,ymedi,zmedi,xj,yj,zj
3545 C Calculate contributions to the Cartesian gradient.
3548 facvdw=-6*rrmij*(ev1+evdwij)
3549 facel=-3*rrmij*(el1+eesij)
3556 * Radial derivatives. First process both termini of the fragment (i,j)
3563 gelc(k,i)=gelc(k,i)+ghalf
3564 gelc(k,j)=gelc(k,j)+ghalf
3567 * Loop over residues i+1 thru j-1.
3571 gelc(l,k)=gelc(l,k)+ggg(l)
3579 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3580 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3583 * Loop over residues i+1 thru j-1.
3587 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3594 fac=-3*rrmij*(facvdw+facvdw+facel)
3600 * Radial derivatives. First process both termini of the fragment (i,j)
3607 gelc(k,i)=gelc(k,i)+ghalf
3608 gelc(k,j)=gelc(k,j)+ghalf
3611 * Loop over residues i+1 thru j-1.
3615 gelc(l,k)=gelc(l,k)+ggg(l)
3622 ecosa=2.0D0*fac3*fac1+fac4
3625 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3626 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3628 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3629 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3631 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3632 cd & (dcosg(k),k=1,3)
3634 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3638 gelc(k,i)=gelc(k,i)+ghalf
3639 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3640 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3641 gelc(k,j)=gelc(k,j)+ghalf
3642 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3643 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3647 gelc(l,k)=gelc(l,k)+ggg(l)
3652 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3653 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3654 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3656 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3657 C energy of a peptide unit is assumed in the form of a second-order
3658 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3659 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3660 C are computed for EVERY pair of non-contiguous peptide groups.
3662 if (j.lt.nres-1) then
3673 muij(kkk)=mu(k,i)*mu(l,j)
3676 cd write (iout,*) 'EELEC: i',i,' j',j
3677 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3678 cd write(iout,*) 'muij',muij
3679 ury=scalar(uy(1,i),erij)
3680 urz=scalar(uz(1,i),erij)
3681 vry=scalar(uy(1,j),erij)
3682 vrz=scalar(uz(1,j),erij)
3683 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3684 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3685 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3686 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3687 C For diagnostics only
3692 fac=dsqrt(-ael6i)*r3ij
3693 cd write (2,*) 'fac=',fac
3694 C For diagnostics only
3700 cd write (iout,'(4i5,4f10.5)')
3701 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3702 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3703 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
3704 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
3705 cd write (iout,'(4f10.5)')
3706 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3707 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3708 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3709 cd write (iout,'(2i3,9f10.5/)') i,j,
3710 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3712 C Derivatives of the elements of A in virtual-bond vectors
3713 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3720 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3721 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3722 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3723 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3724 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3725 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3726 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3727 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3728 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3729 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3730 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3731 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3741 C Compute radial contributions to the gradient
3763 C Add the contributions coming from er
3766 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3767 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3768 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3769 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3772 C Derivatives in DC(i)
3773 ghalf1=0.5d0*agg(k,1)
3774 ghalf2=0.5d0*agg(k,2)
3775 ghalf3=0.5d0*agg(k,3)
3776 ghalf4=0.5d0*agg(k,4)
3777 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3778 & -3.0d0*uryg(k,2)*vry)+ghalf1
3779 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3780 & -3.0d0*uryg(k,2)*vrz)+ghalf2
3781 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3782 & -3.0d0*urzg(k,2)*vry)+ghalf3
3783 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3784 & -3.0d0*urzg(k,2)*vrz)+ghalf4
3785 C Derivatives in DC(i+1)
3786 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3787 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
3788 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3789 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
3790 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3791 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
3792 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3793 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
3794 C Derivatives in DC(j)
3795 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3796 & -3.0d0*vryg(k,2)*ury)+ghalf1
3797 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3798 & -3.0d0*vrzg(k,2)*ury)+ghalf2
3799 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3800 & -3.0d0*vryg(k,2)*urz)+ghalf3
3801 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3802 & -3.0d0*vrzg(k,2)*urz)+ghalf4
3803 C Derivatives in DC(j+1) or DC(nres-1)
3804 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3805 & -3.0d0*vryg(k,3)*ury)
3806 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3807 & -3.0d0*vrzg(k,3)*ury)
3808 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3809 & -3.0d0*vryg(k,3)*urz)
3810 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3811 & -3.0d0*vrzg(k,3)*urz)
3816 C Derivatives in DC(i+1)
3817 cd aggi1(k,1)=agg(k,1)
3818 cd aggi1(k,2)=agg(k,2)
3819 cd aggi1(k,3)=agg(k,3)
3820 cd aggi1(k,4)=agg(k,4)
3821 C Derivatives in DC(j)
3826 C Derivatives in DC(j+1)
3831 if (j.eq.nres-1 .and. i.lt.j-2) then
3833 aggj1(k,l)=aggj1(k,l)+agg(k,l)
3834 cd aggj1(k,l)=agg(k,l)
3840 C Check the loc-el terms by numerical integration
3850 aggi(k,l)=-aggi(k,l)
3851 aggi1(k,l)=-aggi1(k,l)
3852 aggj(k,l)=-aggj(k,l)
3853 aggj1(k,l)=-aggj1(k,l)
3856 if (j.lt.nres-1) then
3862 aggi(k,l)=-aggi(k,l)
3863 aggi1(k,l)=-aggi1(k,l)
3864 aggj(k,l)=-aggj(k,l)
3865 aggj1(k,l)=-aggj1(k,l)
3876 aggi(k,l)=-aggi(k,l)
3877 aggi1(k,l)=-aggi1(k,l)
3878 aggj(k,l)=-aggj(k,l)
3879 aggj1(k,l)=-aggj1(k,l)
3885 IF (wel_loc.gt.0.0d0) THEN
3886 C Contribution to the local-electrostatic energy coming from the i-j pair
3887 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3889 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3890 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3891 eel_loc=eel_loc+eel_loc_ij
3892 C Partial derivatives in virtual-bond dihedral angles gamma
3895 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3896 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3897 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3898 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3899 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3900 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3901 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
3902 cd write(iout,*) 'agg ',agg
3903 cd write(iout,*) 'aggi ',aggi
3904 cd write(iout,*) 'aggi1',aggi1
3905 cd write(iout,*) 'aggj ',aggj
3906 cd write(iout,*) 'aggj1',aggj1
3908 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3910 ggg(l)=agg(l,1)*muij(1)+
3911 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3915 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3918 C Remaining derivatives of eello
3920 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3921 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3922 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3923 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3924 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3925 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3926 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3927 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3931 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3932 C Contributions from turns
3937 call eturn34(i,j,eello_turn3,eello_turn4)
3939 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3940 if (j.gt.i+1 .and. num_conti.le.maxconts) then
3942 C Calculate the contact function. The ith column of the array JCONT will
3943 C contain the numbers of atoms that make contacts with the atom I (of numbers
3944 C greater than I). The arrays FACONT and GACONT will contain the values of
3945 C the contact function and its derivative.
3946 c r0ij=1.02D0*rpp(iteli,itelj)
3947 c r0ij=1.11D0*rpp(iteli,itelj)
3948 r0ij=2.20D0*rpp(iteli,itelj)
3949 c r0ij=1.55D0*rpp(iteli,itelj)
3950 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3951 if (fcont.gt.0.0D0) then
3952 num_conti=num_conti+1
3953 if (num_conti.gt.maxconts) then
3954 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3955 & ' will skip next contacts for this conf.'
3957 jcont_hb(num_conti,i)=j
3958 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3959 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3960 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3962 d_cont(num_conti,i)=rij
3963 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3964 C --- Electrostatic-interaction matrix ---
3965 a_chuj(1,1,num_conti,i)=a22
3966 a_chuj(1,2,num_conti,i)=a23
3967 a_chuj(2,1,num_conti,i)=a32
3968 a_chuj(2,2,num_conti,i)=a33
3969 C --- Gradient of rij
3971 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3974 c a_chuj(1,1,num_conti,i)=-0.61d0
3975 c a_chuj(1,2,num_conti,i)= 0.4d0
3976 c a_chuj(2,1,num_conti,i)= 0.65d0
3977 c a_chuj(2,2,num_conti,i)= 0.50d0
3978 c else if (i.eq.2) then
3979 c a_chuj(1,1,num_conti,i)= 0.0d0
3980 c a_chuj(1,2,num_conti,i)= 0.0d0
3981 c a_chuj(2,1,num_conti,i)= 0.0d0
3982 c a_chuj(2,2,num_conti,i)= 0.0d0
3984 C --- and its gradients
3985 cd write (iout,*) 'i',i,' j',j
3987 cd write (iout,*) 'iii 1 kkk',kkk
3988 cd write (iout,*) agg(kkk,:)
3991 cd write (iout,*) 'iii 2 kkk',kkk
3992 cd write (iout,*) aggi(kkk,:)
3995 cd write (iout,*) 'iii 3 kkk',kkk
3996 cd write (iout,*) aggi1(kkk,:)
3999 cd write (iout,*) 'iii 4 kkk',kkk
4000 cd write (iout,*) aggj(kkk,:)
4003 cd write (iout,*) 'iii 5 kkk',kkk
4004 cd write (iout,*) aggj1(kkk,:)
4011 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4012 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4013 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4014 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4015 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4017 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
4023 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4024 C Calculate contact energies
4026 wij=cosa-3.0D0*cosb*cosg
4029 c fac3=dsqrt(-ael6i)/r0ij**3
4030 fac3=dsqrt(-ael6i)*r3ij
4031 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4032 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4034 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4035 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4036 C Diagnostics. Comment out or remove after debugging!
4037 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4038 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4039 c ees0m(num_conti,i)=0.0D0
4041 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4042 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4043 facont_hb(num_conti,i)=fcont
4045 C Angular derivatives of the contact function
4046 ees0pij1=fac3/ees0pij
4047 ees0mij1=fac3/ees0mij
4048 fac3p=-3.0D0*fac3*rrmij
4049 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4050 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4052 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4053 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4054 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4055 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4056 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4057 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4058 ecosap=ecosa1+ecosa2
4059 ecosbp=ecosb1+ecosb2
4060 ecosgp=ecosg1+ecosg2
4061 ecosam=ecosa1-ecosa2
4062 ecosbm=ecosb1-ecosb2
4063 ecosgm=ecosg1-ecosg2
4072 fprimcont=fprimcont/rij
4073 cd facont_hb(num_conti,i)=1.0D0
4074 C Following line is for diagnostics.
4077 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4078 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4081 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4082 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4084 gggp(1)=gggp(1)+ees0pijp*xj
4085 gggp(2)=gggp(2)+ees0pijp*yj
4086 gggp(3)=gggp(3)+ees0pijp*zj
4087 gggm(1)=gggm(1)+ees0mijp*xj
4088 gggm(2)=gggm(2)+ees0mijp*yj
4089 gggm(3)=gggm(3)+ees0mijp*zj
4090 C Derivatives due to the contact function
4091 gacont_hbr(1,num_conti,i)=fprimcont*xj
4092 gacont_hbr(2,num_conti,i)=fprimcont*yj
4093 gacont_hbr(3,num_conti,i)=fprimcont*zj
4095 ghalfp=0.5D0*gggp(k)
4096 ghalfm=0.5D0*gggm(k)
4097 gacontp_hb1(k,num_conti,i)=ghalfp
4098 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4099 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4100 gacontp_hb2(k,num_conti,i)=ghalfp
4101 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4102 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4103 gacontp_hb3(k,num_conti,i)=gggp(k)
4104 gacontm_hb1(k,num_conti,i)=ghalfm
4105 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4106 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4107 gacontm_hb2(k,num_conti,i)=ghalfm
4108 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4109 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4110 gacontm_hb3(k,num_conti,i)=gggm(k)
4113 C Diagnostics. Comment out or remove after debugging!
4115 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4116 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4117 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4118 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4119 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4120 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4123 endif ! num_conti.le.maxconts
4128 num_cont_hb(i)=num_conti
4132 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
4133 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
4135 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
4136 ccc eel_loc=eel_loc+eello_turn3
4139 C-----------------------------------------------------------------------------
4140 subroutine eturn34(i,j,eello_turn3,eello_turn4)
4141 C Third- and fourth-order contributions from turns
4142 implicit real*8 (a-h,o-z)
4143 include 'DIMENSIONS'
4144 include 'sizesclu.dat'
4145 include 'COMMON.IOUNITS'
4146 include 'COMMON.GEO'
4147 include 'COMMON.VAR'
4148 include 'COMMON.LOCAL'
4149 include 'COMMON.CHAIN'
4150 include 'COMMON.DERIV'
4151 include 'COMMON.INTERACT'
4152 include 'COMMON.CONTACTS'
4153 include 'COMMON.TORSION'
4154 include 'COMMON.VECTORS'
4155 include 'COMMON.FFIELD'
4157 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4158 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4159 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
4160 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4161 & aggj(3,4),aggj1(3,4),a_temp(2,2)
4162 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
4164 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4166 C Third-order contributions
4173 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4174 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4175 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4176 call transpose2(auxmat(1,1),auxmat1(1,1))
4177 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4178 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4179 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4180 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4181 cd & ' eello_turn3_num',4*eello_turn3_num
4183 C Derivatives in gamma(i)
4184 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4185 call transpose2(auxmat2(1,1),pizda(1,1))
4186 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4187 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4188 C Derivatives in gamma(i+1)
4189 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4190 call transpose2(auxmat2(1,1),pizda(1,1))
4191 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4192 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4193 & +0.5d0*(pizda(1,1)+pizda(2,2))
4194 C Cartesian derivatives
4196 a_temp(1,1)=aggi(l,1)
4197 a_temp(1,2)=aggi(l,2)
4198 a_temp(2,1)=aggi(l,3)
4199 a_temp(2,2)=aggi(l,4)
4200 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4201 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4202 & +0.5d0*(pizda(1,1)+pizda(2,2))
4203 a_temp(1,1)=aggi1(l,1)
4204 a_temp(1,2)=aggi1(l,2)
4205 a_temp(2,1)=aggi1(l,3)
4206 a_temp(2,2)=aggi1(l,4)
4207 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4208 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4209 & +0.5d0*(pizda(1,1)+pizda(2,2))
4210 a_temp(1,1)=aggj(l,1)
4211 a_temp(1,2)=aggj(l,2)
4212 a_temp(2,1)=aggj(l,3)
4213 a_temp(2,2)=aggj(l,4)
4214 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4215 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4216 & +0.5d0*(pizda(1,1)+pizda(2,2))
4217 a_temp(1,1)=aggj1(l,1)
4218 a_temp(1,2)=aggj1(l,2)
4219 a_temp(2,1)=aggj1(l,3)
4220 a_temp(2,2)=aggj1(l,4)
4221 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4222 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4223 & +0.5d0*(pizda(1,1)+pizda(2,2))
4226 else if (j.eq.i+3) then
4227 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4229 C Fourth-order contributions
4237 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4238 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4239 iti1=itortyp(itype(i+1))
4240 iti2=itortyp(itype(i+2))
4241 iti3=itortyp(itype(i+3))
4242 call transpose2(EUg(1,1,i+1),e1t(1,1))
4243 call transpose2(Eug(1,1,i+2),e2t(1,1))
4244 call transpose2(Eug(1,1,i+3),e3t(1,1))
4245 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4246 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4247 s1=scalar2(b1(1,iti2),auxvec(1))
4248 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4249 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4250 s2=scalar2(b1(1,iti1),auxvec(1))
4251 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4252 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4253 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4254 eello_turn4=eello_turn4-(s1+s2+s3)
4255 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4256 cd & ' eello_turn4_num',8*eello_turn4_num
4257 C Derivatives in gamma(i)
4259 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4260 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4261 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4262 s1=scalar2(b1(1,iti2),auxvec(1))
4263 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4264 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4265 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4266 C Derivatives in gamma(i+1)
4267 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4268 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4269 s2=scalar2(b1(1,iti1),auxvec(1))
4270 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4271 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4272 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4273 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4274 C Derivatives in gamma(i+2)
4275 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4276 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4277 s1=scalar2(b1(1,iti2),auxvec(1))
4278 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4279 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4280 s2=scalar2(b1(1,iti1),auxvec(1))
4281 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
4282 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4283 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4284 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4285 C Cartesian derivatives
4286 C Derivatives of this turn contributions in DC(i+2)
4287 if (j.lt.nres-1) then
4289 a_temp(1,1)=agg(l,1)
4290 a_temp(1,2)=agg(l,2)
4291 a_temp(2,1)=agg(l,3)
4292 a_temp(2,2)=agg(l,4)
4293 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4294 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4295 s1=scalar2(b1(1,iti2),auxvec(1))
4296 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4297 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4298 s2=scalar2(b1(1,iti1),auxvec(1))
4299 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4300 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4301 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4303 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4306 C Remaining derivatives of this turn contribution
4308 a_temp(1,1)=aggi(l,1)
4309 a_temp(1,2)=aggi(l,2)
4310 a_temp(2,1)=aggi(l,3)
4311 a_temp(2,2)=aggi(l,4)
4312 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4313 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4314 s1=scalar2(b1(1,iti2),auxvec(1))
4315 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4316 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4317 s2=scalar2(b1(1,iti1),auxvec(1))
4318 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4319 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4320 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4321 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4322 a_temp(1,1)=aggi1(l,1)
4323 a_temp(1,2)=aggi1(l,2)
4324 a_temp(2,1)=aggi1(l,3)
4325 a_temp(2,2)=aggi1(l,4)
4326 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4327 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4328 s1=scalar2(b1(1,iti2),auxvec(1))
4329 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4330 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4331 s2=scalar2(b1(1,iti1),auxvec(1))
4332 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4333 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4334 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4335 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4336 a_temp(1,1)=aggj(l,1)
4337 a_temp(1,2)=aggj(l,2)
4338 a_temp(2,1)=aggj(l,3)
4339 a_temp(2,2)=aggj(l,4)
4340 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4341 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4342 s1=scalar2(b1(1,iti2),auxvec(1))
4343 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4344 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4345 s2=scalar2(b1(1,iti1),auxvec(1))
4346 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4347 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4348 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4349 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4350 a_temp(1,1)=aggj1(l,1)
4351 a_temp(1,2)=aggj1(l,2)
4352 a_temp(2,1)=aggj1(l,3)
4353 a_temp(2,2)=aggj1(l,4)
4354 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4355 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4356 s1=scalar2(b1(1,iti2),auxvec(1))
4357 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4358 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4359 s2=scalar2(b1(1,iti1),auxvec(1))
4360 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4361 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4362 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4363 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4369 C-----------------------------------------------------------------------------
4370 subroutine vecpr(u,v,w)
4371 implicit real*8(a-h,o-z)
4372 dimension u(3),v(3),w(3)
4373 w(1)=u(2)*v(3)-u(3)*v(2)
4374 w(2)=-u(1)*v(3)+u(3)*v(1)
4375 w(3)=u(1)*v(2)-u(2)*v(1)
4378 C-----------------------------------------------------------------------------
4379 subroutine unormderiv(u,ugrad,unorm,ungrad)
4380 C This subroutine computes the derivatives of a normalized vector u, given
4381 C the derivatives computed without normalization conditions, ugrad. Returns
4384 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4385 double precision vec(3)
4386 double precision scalar
4388 c write (2,*) 'ugrad',ugrad
4391 vec(i)=scalar(ugrad(1,i),u(1))
4393 c write (2,*) 'vec',vec
4396 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4399 c write (2,*) 'ungrad',ungrad
4402 C-----------------------------------------------------------------------------
4403 subroutine escp(evdw2,evdw2_14)
4405 C This subroutine calculates the excluded-volume interaction energy between
4406 C peptide-group centers and side chains and its gradient in virtual-bond and
4407 C side-chain vectors.
4409 implicit real*8 (a-h,o-z)
4410 include 'DIMENSIONS'
4411 include 'sizesclu.dat'
4412 include 'COMMON.GEO'
4413 include 'COMMON.VAR'
4414 include 'COMMON.LOCAL'
4415 include 'COMMON.CHAIN'
4416 include 'COMMON.DERIV'
4417 include 'COMMON.INTERACT'
4418 include 'COMMON.FFIELD'
4419 include 'COMMON.IOUNITS'
4423 cd print '(a)','Enter ESCP'
4424 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4425 c & ' scal14',scal14
4426 do i=iatscp_s,iatscp_e
4428 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4429 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4430 if (iteli.eq.0) goto 1225
4431 xi=0.5D0*(c(1,i)+c(1,i+1))
4432 yi=0.5D0*(c(2,i)+c(2,i+1))
4433 zi=0.5D0*(c(3,i)+c(3,i+1))
4435 do iint=1,nscp_gr(i)
4437 do j=iscpstart(i,iint),iscpend(i,iint)
4439 C Uncomment following three lines for SC-p interactions
4443 C Uncomment following three lines for Ca-p interactions
4447 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4449 e1=fac*fac*aad(itypj,iteli)
4450 e2=fac*bad(itypj,iteli)
4451 if (iabs(j-i) .le. 2) then
4454 evdw2_14=evdw2_14+e1+e2
4457 c write (iout,*) i,j,evdwij
4461 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4463 fac=-(evdwij+e1)*rrij
4468 cd write (iout,*) 'j<i'
4469 C Uncomment following three lines for SC-p interactions
4471 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4474 cd write (iout,*) 'j>i'
4477 C Uncomment following line for SC-p interactions
4478 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4482 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4486 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4487 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4490 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4500 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4501 gradx_scp(j,i)=expon*gradx_scp(j,i)
4504 C******************************************************************************
4508 C To save time the factor EXPON has been extracted from ALL components
4509 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4512 C******************************************************************************
4515 C--------------------------------------------------------------------------
4516 subroutine edis(ehpb)
4518 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4520 implicit real*8 (a-h,o-z)
4521 include 'DIMENSIONS'
4522 include 'COMMON.SBRIDGE'
4523 include 'COMMON.CHAIN'
4524 include 'COMMON.DERIV'
4525 include 'COMMON.VAR'
4526 include 'COMMON.INTERACT'
4527 include 'COMMON.IOUNITS'
4530 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4531 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4532 if (link_end.eq.0) return
4533 do i=link_start,link_end
4534 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4535 C CA-CA distance used in regularization of structure.
4538 C iii and jjj point to the residues for which the distance is assigned.
4539 if (ii.gt.nres) then
4546 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4547 c & dhpb(i),dhpb1(i),forcon(i)
4548 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4549 C distance and angle dependent SS bond potential.
4550 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4551 call ssbond_ene(iii,jjj,eij)
4553 cd write (iout,*) "eij",eij
4554 else if (ii.gt.nres .and. jj.gt.nres) then
4555 c Restraints from contact prediction
4557 if (dhpb1(i).gt.0.0d0) then
4558 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4559 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4560 c write (iout,*) "beta nmr",
4561 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4565 C Get the force constant corresponding to this distance.
4567 C Calculate the contribution to energy.
4568 ehpb=ehpb+waga*rdis*rdis
4569 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4571 C Evaluate gradient.
4576 ggg(j)=fac*(c(j,jj)-c(j,ii))
4579 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4580 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4583 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4584 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4587 C Calculate the distance between the two points and its difference from the
4590 if (dhpb1(i).gt.0.0d0) then
4591 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4592 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4593 c write (iout,*) "alph nmr",
4594 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4597 C Get the force constant corresponding to this distance.
4599 C Calculate the contribution to energy.
4600 ehpb=ehpb+waga*rdis*rdis
4601 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4603 C Evaluate gradient.
4607 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4608 cd & ' waga=',waga,' fac=',fac
4610 ggg(j)=fac*(c(j,jj)-c(j,ii))
4612 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4613 C If this is a SC-SC distance, we need to calculate the contributions to the
4614 C Cartesian gradient in the SC vectors (ghpbx).
4617 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4618 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4622 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4623 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4630 C--------------------------------------------------------------------------
4631 subroutine ssbond_ene(i,j,eij)
4633 C Calculate the distance and angle dependent SS-bond potential energy
4634 C using a free-energy function derived based on RHF/6-31G** ab initio
4635 C calculations of diethyl disulfide.
4637 C A. Liwo and U. Kozlowska, 11/24/03
4639 implicit real*8 (a-h,o-z)
4640 include 'DIMENSIONS'
4641 include 'sizesclu.dat'
4642 include 'COMMON.SBRIDGE'
4643 include 'COMMON.CHAIN'
4644 include 'COMMON.DERIV'
4645 include 'COMMON.LOCAL'
4646 include 'COMMON.INTERACT'
4647 include 'COMMON.VAR'
4648 include 'COMMON.IOUNITS'
4649 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4654 dxi=dc_norm(1,nres+i)
4655 dyi=dc_norm(2,nres+i)
4656 dzi=dc_norm(3,nres+i)
4657 dsci_inv=dsc_inv(itypi)
4659 dscj_inv=dsc_inv(itypj)
4663 dxj=dc_norm(1,nres+j)
4664 dyj=dc_norm(2,nres+j)
4665 dzj=dc_norm(3,nres+j)
4666 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4671 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4672 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4673 om12=dxi*dxj+dyi*dyj+dzi*dzj
4675 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4676 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4682 deltat12=om2-om1+2.0d0
4684 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4685 & +akct*deltad*deltat12
4686 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4687 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4688 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4689 c & " deltat12",deltat12," eij",eij
4690 ed=2*akcm*deltad+akct*deltat12
4692 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4693 eom1=-2*akth*deltat1-pom1-om2*pom2
4694 eom2= 2*akth*deltat2+pom1-om1*pom2
4697 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4700 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4701 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4702 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4703 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4706 C Calculate the components of the gradient in DC and X
4710 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4715 C--------------------------------------------------------------------------
4716 subroutine ebond(estr)
4718 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4720 implicit real*8 (a-h,o-z)
4721 include 'DIMENSIONS'
4722 include 'COMMON.LOCAL'
4723 include 'COMMON.GEO'
4724 include 'COMMON.INTERACT'
4725 include 'COMMON.DERIV'
4726 include 'COMMON.VAR'
4727 include 'COMMON.CHAIN'
4728 include 'COMMON.IOUNITS'
4729 include 'COMMON.NAMES'
4730 include 'COMMON.FFIELD'
4731 include 'COMMON.CONTROL'
4732 double precision u(3),ud(3)
4735 diff = vbld(i)-vbldp0
4736 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4739 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4744 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4751 diff=vbld(i+nres)-vbldsc0(1,iti)
4752 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4753 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4754 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4756 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4760 diff=vbld(i+nres)-vbldsc0(j,iti)
4761 ud(j)=aksc(j,iti)*diff
4762 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4776 uprod2=uprod2*u(k)*u(k)
4780 usumsqder=usumsqder+ud(j)*uprod2
4782 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4783 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4784 estr=estr+uprod/usum
4786 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4794 C--------------------------------------------------------------------------
4795 subroutine ebend(etheta)
4797 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4798 C angles gamma and its derivatives in consecutive thetas and gammas.
4800 implicit real*8 (a-h,o-z)
4801 include 'DIMENSIONS'
4802 include 'sizesclu.dat'
4803 include 'COMMON.LOCAL'
4804 include 'COMMON.GEO'
4805 include 'COMMON.INTERACT'
4806 include 'COMMON.DERIV'
4807 include 'COMMON.VAR'
4808 include 'COMMON.CHAIN'
4809 include 'COMMON.IOUNITS'
4810 include 'COMMON.NAMES'
4811 include 'COMMON.FFIELD'
4812 common /calcthet/ term1,term2,termm,diffak,ratak,
4813 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4814 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4815 double precision y(2),z(2)
4817 time11=dexp(-2*time)
4820 c write (iout,*) "nres",nres
4821 c write (*,'(a,i2)') 'EBEND ICG=',icg
4822 c write (iout,*) ithet_start,ithet_end
4823 do i=ithet_start,ithet_end
4824 C Zero the energy function and its derivative at 0 or pi.
4825 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4827 c if (i.gt.ithet_start .and.
4828 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
4829 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
4837 c if (i.lt.nres .and. itel(i).ne.0) then
4849 call proc_proc(phii,icrc)
4850 if (icrc.eq.1) phii=150.0
4864 call proc_proc(phii1,icrc)
4865 if (icrc.eq.1) phii1=150.0
4877 C Calculate the "mean" value of theta from the part of the distribution
4878 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4879 C In following comments this theta will be referred to as t_c.
4880 thet_pred_mean=0.0d0
4884 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4886 c write (iout,*) "thet_pred_mean",thet_pred_mean
4887 dthett=thet_pred_mean*ssd
4888 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4889 c write (iout,*) "thet_pred_mean",thet_pred_mean
4890 C Derivatives of the "mean" values in gamma1 and gamma2.
4891 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4892 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4893 if (theta(i).gt.pi-delta) then
4894 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4896 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4897 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4898 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4900 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4902 else if (theta(i).lt.delta) then
4903 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4904 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4905 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4907 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4908 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4911 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4914 etheta=etheta+ethetai
4915 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4916 c & rad2deg*phii,rad2deg*phii1,ethetai
4917 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4918 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4919 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4922 C Ufff.... We've done all this!!!
4925 C---------------------------------------------------------------------------
4926 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4928 implicit real*8 (a-h,o-z)
4929 include 'DIMENSIONS'
4930 include 'COMMON.LOCAL'
4931 include 'COMMON.IOUNITS'
4932 common /calcthet/ term1,term2,termm,diffak,ratak,
4933 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4934 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4935 C Calculate the contributions to both Gaussian lobes.
4936 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4937 C The "polynomial part" of the "standard deviation" of this part of
4941 sig=sig*thet_pred_mean+polthet(j,it)
4943 C Derivative of the "interior part" of the "standard deviation of the"
4944 C gamma-dependent Gaussian lobe in t_c.
4945 sigtc=3*polthet(3,it)
4947 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4950 C Set the parameters of both Gaussian lobes of the distribution.
4951 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4952 fac=sig*sig+sigc0(it)
4955 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4956 sigsqtc=-4.0D0*sigcsq*sigtc
4957 c print *,i,sig,sigtc,sigsqtc
4958 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4959 sigtc=-sigtc/(fac*fac)
4960 C Following variable is sigma(t_c)**(-2)
4961 sigcsq=sigcsq*sigcsq
4963 sig0inv=1.0D0/sig0i**2
4964 delthec=thetai-thet_pred_mean
4965 delthe0=thetai-theta0i
4966 term1=-0.5D0*sigcsq*delthec*delthec
4967 term2=-0.5D0*sig0inv*delthe0*delthe0
4968 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4969 C NaNs in taking the logarithm. We extract the largest exponent which is added
4970 C to the energy (this being the log of the distribution) at the end of energy
4971 C term evaluation for this virtual-bond angle.
4972 if (term1.gt.term2) then
4974 term2=dexp(term2-termm)
4978 term1=dexp(term1-termm)
4981 C The ratio between the gamma-independent and gamma-dependent lobes of
4982 C the distribution is a Gaussian function of thet_pred_mean too.
4983 diffak=gthet(2,it)-thet_pred_mean
4984 ratak=diffak/gthet(3,it)**2
4985 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4986 C Let's differentiate it in thet_pred_mean NOW.
4988 C Now put together the distribution terms to make complete distribution.
4989 termexp=term1+ak*term2
4990 termpre=sigc+ak*sig0i
4991 C Contribution of the bending energy from this theta is just the -log of
4992 C the sum of the contributions from the two lobes and the pre-exponential
4993 C factor. Simple enough, isn't it?
4994 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4995 C NOW the derivatives!!!
4996 C 6/6/97 Take into account the deformation.
4997 E_theta=(delthec*sigcsq*term1
4998 & +ak*delthe0*sig0inv*term2)/termexp
4999 E_tc=((sigtc+aktc*sig0i)/termpre
5000 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5001 & aktc*term2)/termexp)
5004 c-----------------------------------------------------------------------------
5005 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5006 implicit real*8 (a-h,o-z)
5007 include 'DIMENSIONS'
5008 include 'COMMON.LOCAL'
5009 include 'COMMON.IOUNITS'
5010 common /calcthet/ term1,term2,termm,diffak,ratak,
5011 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5012 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5013 delthec=thetai-thet_pred_mean
5014 delthe0=thetai-theta0i
5015 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5016 t3 = thetai-thet_pred_mean
5020 t14 = t12+t6*sigsqtc
5022 t21 = thetai-theta0i
5028 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5029 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5030 & *(-t12*t9-ak*sig0inv*t27)
5034 C--------------------------------------------------------------------------
5035 subroutine ebend(etheta)
5037 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5038 C angles gamma and its derivatives in consecutive thetas and gammas.
5039 C ab initio-derived potentials from
5040 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5042 implicit real*8 (a-h,o-z)
5043 include 'DIMENSIONS'
5044 include 'COMMON.LOCAL'
5045 include 'COMMON.GEO'
5046 include 'COMMON.INTERACT'
5047 include 'COMMON.DERIV'
5048 include 'COMMON.VAR'
5049 include 'COMMON.CHAIN'
5050 include 'COMMON.IOUNITS'
5051 include 'COMMON.NAMES'
5052 include 'COMMON.FFIELD'
5053 include 'COMMON.CONTROL'
5054 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5055 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5056 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5057 & sinph1ph2(maxdouble,maxdouble)
5058 logical lprn /.false./, lprn1 /.false./
5060 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5061 do i=ithet_start,ithet_end
5065 theti2=0.5d0*theta(i)
5066 ityp2=ithetyp(itype(i-1))
5068 coskt(k)=dcos(k*theti2)
5069 sinkt(k)=dsin(k*theti2)
5074 if (phii.ne.phii) phii=150.0
5078 ityp1=ithetyp(itype(i-2))
5080 cosph1(k)=dcos(k*phii)
5081 sinph1(k)=dsin(k*phii)
5094 if (phii1.ne.phii1) phii1=150.0
5099 ityp3=ithetyp(itype(i))
5101 cosph2(k)=dcos(k*phii1)
5102 sinph2(k)=dsin(k*phii1)
5112 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5113 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5115 ethetai=aa0thet(ityp1,ityp2,ityp3)
5118 ccl=cosph1(l)*cosph2(k-l)
5119 ssl=sinph1(l)*sinph2(k-l)
5120 scl=sinph1(l)*cosph2(k-l)
5121 csl=cosph1(l)*sinph2(k-l)
5122 cosph1ph2(l,k)=ccl-ssl
5123 cosph1ph2(k,l)=ccl+ssl
5124 sinph1ph2(l,k)=scl+csl
5125 sinph1ph2(k,l)=scl-csl
5129 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5130 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5131 write (iout,*) "coskt and sinkt"
5133 write (iout,*) k,coskt(k),sinkt(k)
5137 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
5138 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
5141 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
5142 & " ethetai",ethetai
5145 write (iout,*) "cosph and sinph"
5147 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5149 write (iout,*) "cosph1ph2 and sinph2ph2"
5152 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5153 & sinph1ph2(l,k),sinph1ph2(k,l)
5156 write(iout,*) "ethetai",ethetai
5160 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
5161 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
5162 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
5163 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
5164 ethetai=ethetai+sinkt(m)*aux
5165 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5166 dephii=dephii+k*sinkt(m)*(
5167 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
5168 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
5169 dephii1=dephii1+k*sinkt(m)*(
5170 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
5171 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
5173 & write (iout,*) "m",m," k",k," bbthet",
5174 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
5175 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
5176 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
5177 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5181 & write(iout,*) "ethetai",ethetai
5185 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5186 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
5187 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5188 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
5189 ethetai=ethetai+sinkt(m)*aux
5190 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5191 dephii=dephii+l*sinkt(m)*(
5192 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
5193 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5194 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5195 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5196 dephii1=dephii1+(k-l)*sinkt(m)*(
5197 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5198 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5199 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5200 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5202 write (iout,*) "m",m," k",k," l",l," ffthet",
5203 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5204 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5205 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5206 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5207 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5208 & cosph1ph2(k,l)*sinkt(m),
5209 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5215 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5216 & i,theta(i)*rad2deg,phii*rad2deg,
5217 & phii1*rad2deg,ethetai
5218 etheta=etheta+ethetai
5219 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5220 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5221 gloc(nphi+i-2,icg)=wang*dethetai
5227 c-----------------------------------------------------------------------------
5228 subroutine esc(escloc)
5229 C Calculate the local energy of a side chain and its derivatives in the
5230 C corresponding virtual-bond valence angles THETA and the spherical angles
5232 implicit real*8 (a-h,o-z)
5233 include 'DIMENSIONS'
5234 include 'sizesclu.dat'
5235 include 'COMMON.GEO'
5236 include 'COMMON.LOCAL'
5237 include 'COMMON.VAR'
5238 include 'COMMON.INTERACT'
5239 include 'COMMON.DERIV'
5240 include 'COMMON.CHAIN'
5241 include 'COMMON.IOUNITS'
5242 include 'COMMON.NAMES'
5243 include 'COMMON.FFIELD'
5244 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5245 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5246 common /sccalc/ time11,time12,time112,theti,it,nlobit
5249 c write (iout,'(a)') 'ESC'
5250 do i=loc_start,loc_end
5252 if (it.eq.10) goto 1
5254 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5255 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5256 theti=theta(i+1)-pipol
5260 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5262 if (x(2).gt.pi-delta) then
5266 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5268 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5269 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5271 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5272 & ddersc0(1),dersc(1))
5273 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5274 & ddersc0(3),dersc(3))
5276 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5278 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5279 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5280 & dersc0(2),esclocbi,dersc02)
5281 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5283 call splinthet(x(2),0.5d0*delta,ss,ssd)
5288 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5290 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5291 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5293 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5295 c write (iout,*) escloci
5296 else if (x(2).lt.delta) then
5300 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5302 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5303 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5305 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5306 & ddersc0(1),dersc(1))
5307 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5308 & ddersc0(3),dersc(3))
5310 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5312 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5313 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5314 & dersc0(2),esclocbi,dersc02)
5315 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5320 call splinthet(x(2),0.5d0*delta,ss,ssd)
5322 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5324 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5325 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5327 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5328 c write (iout,*) escloci
5330 call enesc(x,escloci,dersc,ddummy,.false.)
5333 escloc=escloc+escloci
5334 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5336 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5338 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5339 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5344 C---------------------------------------------------------------------------
5345 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5346 implicit real*8 (a-h,o-z)
5347 include 'DIMENSIONS'
5348 include 'COMMON.GEO'
5349 include 'COMMON.LOCAL'
5350 include 'COMMON.IOUNITS'
5351 common /sccalc/ time11,time12,time112,theti,it,nlobit
5352 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5353 double precision contr(maxlob,-1:1)
5355 c write (iout,*) 'it=',it,' nlobit=',nlobit
5359 if (mixed) ddersc(j)=0.0d0
5363 C Because of periodicity of the dependence of the SC energy in omega we have
5364 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5365 C To avoid underflows, first compute & store the exponents.
5373 z(k)=x(k)-censc(k,j,it)
5378 Axk=Axk+gaussc(l,k,j,it)*z(l)
5384 expfac=expfac+Ax(k,j,iii)*z(k)
5392 C As in the case of ebend, we want to avoid underflows in exponentiation and
5393 C subsequent NaNs and INFs in energy calculation.
5394 C Find the largest exponent
5398 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5402 cd print *,'it=',it,' emin=',emin
5404 C Compute the contribution to SC energy and derivatives
5408 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5409 cd print *,'j=',j,' expfac=',expfac
5410 escloc_i=escloc_i+expfac
5412 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5416 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5417 & +gaussc(k,2,j,it))*expfac
5424 dersc(1)=dersc(1)/cos(theti)**2
5425 ddersc(1)=ddersc(1)/cos(theti)**2
5428 escloci=-(dlog(escloc_i)-emin)
5430 dersc(j)=dersc(j)/escloc_i
5434 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5439 C------------------------------------------------------------------------------
5440 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5441 implicit real*8 (a-h,o-z)
5442 include 'DIMENSIONS'
5443 include 'COMMON.GEO'
5444 include 'COMMON.LOCAL'
5445 include 'COMMON.IOUNITS'
5446 common /sccalc/ time11,time12,time112,theti,it,nlobit
5447 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5448 double precision contr(maxlob)
5459 z(k)=x(k)-censc(k,j,it)
5465 Axk=Axk+gaussc(l,k,j,it)*z(l)
5471 expfac=expfac+Ax(k,j)*z(k)
5476 C As in the case of ebend, we want to avoid underflows in exponentiation and
5477 C subsequent NaNs and INFs in energy calculation.
5478 C Find the largest exponent
5481 if (emin.gt.contr(j)) emin=contr(j)
5485 C Compute the contribution to SC energy and derivatives
5489 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5490 escloc_i=escloc_i+expfac
5492 dersc(k)=dersc(k)+Ax(k,j)*expfac
5494 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5495 & +gaussc(1,2,j,it))*expfac
5499 dersc(1)=dersc(1)/cos(theti)**2
5500 dersc12=dersc12/cos(theti)**2
5501 escloci=-(dlog(escloc_i)-emin)
5503 dersc(j)=dersc(j)/escloc_i
5505 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5509 c----------------------------------------------------------------------------------
5510 subroutine esc(escloc)
5511 C Calculate the local energy of a side chain and its derivatives in the
5512 C corresponding virtual-bond valence angles THETA and the spherical angles
5513 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5514 C added by Urszula Kozlowska. 07/11/2007
5516 implicit real*8 (a-h,o-z)
5517 include 'DIMENSIONS'
5518 include 'COMMON.GEO'
5519 include 'COMMON.LOCAL'
5520 include 'COMMON.VAR'
5521 include 'COMMON.SCROT'
5522 include 'COMMON.INTERACT'
5523 include 'COMMON.DERIV'
5524 include 'COMMON.CHAIN'
5525 include 'COMMON.IOUNITS'
5526 include 'COMMON.NAMES'
5527 include 'COMMON.FFIELD'
5528 include 'COMMON.CONTROL'
5529 include 'COMMON.VECTORS'
5530 double precision x_prime(3),y_prime(3),z_prime(3)
5531 & , sumene,dsc_i,dp2_i,x(65),
5532 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5533 & de_dxx,de_dyy,de_dzz,de_dt
5534 double precision s1_t,s1_6_t,s2_t,s2_6_t
5536 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5537 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5538 & dt_dCi(3),dt_dCi1(3)
5539 common /sccalc/ time11,time12,time112,theti,it,nlobit
5542 do i=loc_start,loc_end
5543 costtab(i+1) =dcos(theta(i+1))
5544 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5545 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5546 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5547 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5548 cosfac=dsqrt(cosfac2)
5549 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5550 sinfac=dsqrt(sinfac2)
5552 if (it.eq.10) goto 1
5554 C Compute the axes of tghe local cartesian coordinates system; store in
5555 c x_prime, y_prime and z_prime
5562 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5563 C & dc_norm(3,i+nres)
5565 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5566 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5569 z_prime(j) = -uz(j,i-1)
5572 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5573 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5574 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5575 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5576 c & " xy",scalar(x_prime(1),y_prime(1)),
5577 c & " xz",scalar(x_prime(1),z_prime(1)),
5578 c & " yy",scalar(y_prime(1),y_prime(1)),
5579 c & " yz",scalar(y_prime(1),z_prime(1)),
5580 c & " zz",scalar(z_prime(1),z_prime(1))
5582 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5583 C to local coordinate system. Store in xx, yy, zz.
5589 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5590 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5591 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5598 C Compute the energy of the ith side cbain
5600 c write (2,*) "xx",xx," yy",yy," zz",zz
5603 x(j) = sc_parmin(j,it)
5606 Cc diagnostics - remove later
5608 yy1 = dsin(alph(2))*dcos(omeg(2))
5609 zz1 = -dsin(alph(2))*dsin(omeg(2))
5610 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5611 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5613 C," --- ", xx_w,yy_w,zz_w
5616 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5617 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5619 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5620 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5622 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5623 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5624 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5625 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5626 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5628 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5629 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5630 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5631 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5632 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5634 dsc_i = 0.743d0+x(61)
5636 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5637 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5638 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5639 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5640 s1=(1+x(63))/(0.1d0 + dscp1)
5641 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5642 s2=(1+x(65))/(0.1d0 + dscp2)
5643 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5644 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5645 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5646 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5648 c & dscp1,dscp2,sumene
5649 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5650 escloc = escloc + sumene
5651 c write (2,*) "escloc",escloc
5652 if (.not. calc_grad) goto 1
5655 C This section to check the numerical derivatives of the energy of ith side
5656 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5657 C #define DEBUG in the code to turn it on.
5659 write (2,*) "sumene =",sumene
5663 write (2,*) xx,yy,zz
5664 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5665 de_dxx_num=(sumenep-sumene)/aincr
5667 write (2,*) "xx+ sumene from enesc=",sumenep
5670 write (2,*) xx,yy,zz
5671 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5672 de_dyy_num=(sumenep-sumene)/aincr
5674 write (2,*) "yy+ sumene from enesc=",sumenep
5677 write (2,*) xx,yy,zz
5678 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5679 de_dzz_num=(sumenep-sumene)/aincr
5681 write (2,*) "zz+ sumene from enesc=",sumenep
5682 costsave=cost2tab(i+1)
5683 sintsave=sint2tab(i+1)
5684 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5685 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5686 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5687 de_dt_num=(sumenep-sumene)/aincr
5688 write (2,*) " t+ sumene from enesc=",sumenep
5689 cost2tab(i+1)=costsave
5690 sint2tab(i+1)=sintsave
5691 C End of diagnostics section.
5694 C Compute the gradient of esc
5696 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5697 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5698 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5699 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5700 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5701 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5702 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5703 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5704 pom1=(sumene3*sint2tab(i+1)+sumene1)
5705 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5706 pom2=(sumene4*cost2tab(i+1)+sumene2)
5707 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5708 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5709 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5710 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5712 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5713 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5714 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5716 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5717 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5718 & +(pom1+pom2)*pom_dx
5720 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5723 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5724 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5725 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5727 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5728 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5729 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5730 & +x(59)*zz**2 +x(60)*xx*zz
5731 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5732 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5733 & +(pom1-pom2)*pom_dy
5735 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5738 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5739 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5740 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5741 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5742 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5743 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5744 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5745 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5747 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5750 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5751 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5752 & +pom1*pom_dt1+pom2*pom_dt2
5754 write(2,*), "de_dt = ", de_dt,de_dt_num
5758 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5759 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5760 cosfac2xx=cosfac2*xx
5761 sinfac2yy=sinfac2*yy
5763 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5765 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5767 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5768 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5769 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5770 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5771 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5772 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5773 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5774 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5775 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5776 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5780 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5781 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5784 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5785 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5786 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5788 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5789 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5793 dXX_Ctab(k,i)=dXX_Ci(k)
5794 dXX_C1tab(k,i)=dXX_Ci1(k)
5795 dYY_Ctab(k,i)=dYY_Ci(k)
5796 dYY_C1tab(k,i)=dYY_Ci1(k)
5797 dZZ_Ctab(k,i)=dZZ_Ci(k)
5798 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5799 dXX_XYZtab(k,i)=dXX_XYZ(k)
5800 dYY_XYZtab(k,i)=dYY_XYZ(k)
5801 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5805 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5806 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5807 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5808 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5809 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5811 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5812 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5813 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5814 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5815 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5816 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5817 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5818 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5820 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5821 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5823 C to check gradient call subroutine check_grad
5830 c------------------------------------------------------------------------------
5831 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5833 C This procedure calculates two-body contact function g(rij) and its derivative:
5836 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5839 C where x=(rij-r0ij)/delta
5841 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5844 double precision rij,r0ij,eps0ij,fcont,fprimcont
5845 double precision x,x2,x4,delta
5849 if (x.lt.-1.0D0) then
5852 else if (x.le.1.0D0) then
5855 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5856 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5863 c------------------------------------------------------------------------------
5864 subroutine splinthet(theti,delta,ss,ssder)
5865 implicit real*8 (a-h,o-z)
5866 include 'DIMENSIONS'
5867 include 'sizesclu.dat'
5868 include 'COMMON.VAR'
5869 include 'COMMON.GEO'
5872 if (theti.gt.pipol) then
5873 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5875 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5880 c------------------------------------------------------------------------------
5881 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5883 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5884 double precision ksi,ksi2,ksi3,a1,a2,a3
5885 a1=fprim0*delta/(f1-f0)
5891 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5892 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5895 c------------------------------------------------------------------------------
5896 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5898 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5899 double precision ksi,ksi2,ksi3,a1,a2,a3
5904 a2=3*(f1x-f0x)-2*fprim0x*delta
5905 a3=fprim0x*delta-2*(f1x-f0x)
5906 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5909 C-----------------------------------------------------------------------------
5911 C-----------------------------------------------------------------------------
5912 subroutine etor(etors,edihcnstr,fact)
5913 implicit real*8 (a-h,o-z)
5914 include 'DIMENSIONS'
5915 include 'sizesclu.dat'
5916 include 'COMMON.VAR'
5917 include 'COMMON.GEO'
5918 include 'COMMON.LOCAL'
5919 include 'COMMON.TORSION'
5920 include 'COMMON.INTERACT'
5921 include 'COMMON.DERIV'
5922 include 'COMMON.CHAIN'
5923 include 'COMMON.NAMES'
5924 include 'COMMON.IOUNITS'
5925 include 'COMMON.FFIELD'
5926 include 'COMMON.TORCNSTR'
5928 C Set lprn=.true. for debugging
5932 do i=iphi_start,iphi_end
5933 itori=itortyp(itype(i-2))
5934 itori1=itortyp(itype(i-1))
5937 C Proline-Proline pair is a special case...
5938 if (itori.eq.3 .and. itori1.eq.3) then
5939 if (phii.gt.-dwapi3) then
5941 fac=1.0D0/(1.0D0-cosphi)
5942 etorsi=v1(1,3,3)*fac
5943 etorsi=etorsi+etorsi
5944 etors=etors+etorsi-v1(1,3,3)
5945 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5948 v1ij=v1(j+1,itori,itori1)
5949 v2ij=v2(j+1,itori,itori1)
5952 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5953 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5957 v1ij=v1(j,itori,itori1)
5958 v2ij=v2(j,itori,itori1)
5961 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5962 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5966 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5967 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5968 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5969 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5970 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5972 ! 6/20/98 - dihedral angle constraints
5975 itori=idih_constr(i)
5977 difi=pinorm(phii-phi0(i))
5978 if (difi.gt.drange(i)) then
5980 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5981 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5982 else if (difi.lt.-drange(i)) then
5984 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5985 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5987 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5988 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5990 write (iout,*) 'edihcnstr',edihcnstr
5993 c------------------------------------------------------------------------------
5995 subroutine etor(etors,edihcnstr,fact)
5996 implicit real*8 (a-h,o-z)
5997 include 'DIMENSIONS'
5998 include 'sizesclu.dat'
5999 include 'COMMON.VAR'
6000 include 'COMMON.GEO'
6001 include 'COMMON.LOCAL'
6002 include 'COMMON.TORSION'
6003 include 'COMMON.INTERACT'
6004 include 'COMMON.DERIV'
6005 include 'COMMON.CHAIN'
6006 include 'COMMON.NAMES'
6007 include 'COMMON.IOUNITS'
6008 include 'COMMON.FFIELD'
6009 include 'COMMON.TORCNSTR'
6011 C Set lprn=.true. for debugging
6015 do i=iphi_start,iphi_end
6016 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6017 itori=itortyp(itype(i-2))
6018 itori1=itortyp(itype(i-1))
6021 C Regular cosine and sine terms
6022 do j=1,nterm(itori,itori1)
6023 v1ij=v1(j,itori,itori1)
6024 v2ij=v2(j,itori,itori1)
6027 etors=etors+v1ij*cosphi+v2ij*sinphi
6028 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6032 C E = SUM ----------------------------------- - v1
6033 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6035 cosphi=dcos(0.5d0*phii)
6036 sinphi=dsin(0.5d0*phii)
6037 do j=1,nlor(itori,itori1)
6038 vl1ij=vlor1(j,itori,itori1)
6039 vl2ij=vlor2(j,itori,itori1)
6040 vl3ij=vlor3(j,itori,itori1)
6041 pom=vl2ij*cosphi+vl3ij*sinphi
6042 pom1=1.0d0/(pom*pom+1.0d0)
6043 etors=etors+vl1ij*pom1
6045 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6047 C Subtract the constant term
6048 etors=etors-v0(itori,itori1)
6050 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6051 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6052 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6053 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6054 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6057 ! 6/20/98 - dihedral angle constraints
6059 c write (iout,*) "Dihedral angle restraint energy"
6061 itori=idih_constr(i)
6063 difi=pinorm(phii-phi0(i))
6064 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6065 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
6066 if (difi.gt.drange(i)) then
6068 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6069 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6070 c write (iout,*) 0.25d0*ftors*difi**4
6071 else if (difi.lt.-drange(i)) then
6073 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6074 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6075 c write (iout,*) 0.25d0*ftors*difi**4
6078 c write (iout,*) 'edihcnstr',edihcnstr
6081 c----------------------------------------------------------------------------
6082 subroutine etor_d(etors_d,fact2)
6083 C 6/23/01 Compute double torsional energy
6084 implicit real*8 (a-h,o-z)
6085 include 'DIMENSIONS'
6086 include 'sizesclu.dat'
6087 include 'COMMON.VAR'
6088 include 'COMMON.GEO'
6089 include 'COMMON.LOCAL'
6090 include 'COMMON.TORSION'
6091 include 'COMMON.INTERACT'
6092 include 'COMMON.DERIV'
6093 include 'COMMON.CHAIN'
6094 include 'COMMON.NAMES'
6095 include 'COMMON.IOUNITS'
6096 include 'COMMON.FFIELD'
6097 include 'COMMON.TORCNSTR'
6099 C Set lprn=.true. for debugging
6103 do i=iphi_start,iphi_end-1
6104 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6106 itori=itortyp(itype(i-2))
6107 itori1=itortyp(itype(i-1))
6108 itori2=itortyp(itype(i))
6113 C Regular cosine and sine terms
6114 do j=1,ntermd_1(itori,itori1,itori2)
6115 v1cij=v1c(1,j,itori,itori1,itori2)
6116 v1sij=v1s(1,j,itori,itori1,itori2)
6117 v2cij=v1c(2,j,itori,itori1,itori2)
6118 v2sij=v1s(2,j,itori,itori1,itori2)
6119 cosphi1=dcos(j*phii)
6120 sinphi1=dsin(j*phii)
6121 cosphi2=dcos(j*phii1)
6122 sinphi2=dsin(j*phii1)
6123 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6124 & v2cij*cosphi2+v2sij*sinphi2
6125 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6126 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6128 do k=2,ntermd_2(itori,itori1,itori2)
6130 v1cdij = v2c(k,l,itori,itori1,itori2)
6131 v2cdij = v2c(l,k,itori,itori1,itori2)
6132 v1sdij = v2s(k,l,itori,itori1,itori2)
6133 v2sdij = v2s(l,k,itori,itori1,itori2)
6134 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6135 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6136 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6137 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6138 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6139 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6140 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6141 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6142 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6143 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6146 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6147 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6153 c------------------------------------------------------------------------------
6154 subroutine eback_sc_corr(esccor,fact)
6155 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6156 c conformational states; temporarily implemented as differences
6157 c between UNRES torsional potentials (dependent on three types of
6158 c residues) and the torsional potentials dependent on all 20 types
6159 c of residues computed from AM1 energy surfaces of terminally-blocked
6160 c amino-acid residues.
6161 implicit real*8 (a-h,o-z)
6162 include 'DIMENSIONS'
6163 include 'COMMON.VAR'
6164 include 'COMMON.GEO'
6165 include 'COMMON.LOCAL'
6166 include 'COMMON.TORSION'
6167 include 'COMMON.SCCOR'
6168 include 'COMMON.INTERACT'
6169 include 'COMMON.DERIV'
6170 include 'COMMON.CHAIN'
6171 include 'COMMON.NAMES'
6172 include 'COMMON.IOUNITS'
6173 include 'COMMON.FFIELD'
6174 include 'COMMON.CONTROL'
6176 C Set lprn=.true. for debugging
6179 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
6181 do i=itau_start,itau_end
6183 isccori=isccortyp(itype(i-2))
6184 isccori1=isccortyp(itype(i-1))
6186 cccc Added 9 May 2012
6187 cc Tauangle is torsional engle depending on the value of first digit
6188 c(see comment below)
6189 cc Omicron is flat angle depending on the value of first digit
6190 c(see comment below)
6193 do intertyp=1,3 !intertyp
6194 cc Added 09 May 2012 (Adasko)
6195 cc Intertyp means interaction type of backbone mainchain correlation:
6196 c 1 = SC...Ca...Ca...Ca
6197 c 2 = Ca...Ca...Ca...SC
6198 c 3 = SC...Ca...Ca...SCi
6200 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6201 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6202 & (itype(i-1).eq.21)))
6203 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6204 & .or.(itype(i-2).eq.21)))
6205 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6206 & (itype(i-1).eq.21)))) cycle
6207 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6208 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6210 do j=1,nterm_sccor(isccori,isccori1)
6211 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6212 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6213 cosphi=dcos(j*tauangle(intertyp,i))
6214 sinphi=dsin(j*tauangle(intertyp,i))
6215 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6216 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6218 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6219 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6220 c &gloc_sc(intertyp,i-3,icg)
6222 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6223 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6224 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6225 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6226 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6232 c------------------------------------------------------------------------------
6233 subroutine multibody(ecorr)
6234 C This subroutine calculates multi-body contributions to energy following
6235 C the idea of Skolnick et al. If side chains I and J make a contact and
6236 C at the same time side chains I+1 and J+1 make a contact, an extra
6237 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6238 implicit real*8 (a-h,o-z)
6239 include 'DIMENSIONS'
6240 include 'COMMON.IOUNITS'
6241 include 'COMMON.DERIV'
6242 include 'COMMON.INTERACT'
6243 include 'COMMON.CONTACTS'
6244 double precision gx(3),gx1(3)
6247 C Set lprn=.true. for debugging
6251 write (iout,'(a)') 'Contact function values:'
6253 write (iout,'(i2,20(1x,i2,f10.5))')
6254 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6269 num_conti=num_cont(i)
6270 num_conti1=num_cont(i1)
6275 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6276 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6277 cd & ' ishift=',ishift
6278 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6279 C The system gains extra energy.
6280 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6281 endif ! j1==j+-ishift
6290 c------------------------------------------------------------------------------
6291 double precision function esccorr(i,j,k,l,jj,kk)
6292 implicit real*8 (a-h,o-z)
6293 include 'DIMENSIONS'
6294 include 'COMMON.IOUNITS'
6295 include 'COMMON.DERIV'
6296 include 'COMMON.INTERACT'
6297 include 'COMMON.CONTACTS'
6298 double precision gx(3),gx1(3)
6303 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6304 C Calculate the multi-body contribution to energy.
6305 C Calculate multi-body contributions to the gradient.
6306 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6307 cd & k,l,(gacont(m,kk,k),m=1,3)
6309 gx(m) =ekl*gacont(m,jj,i)
6310 gx1(m)=eij*gacont(m,kk,k)
6311 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6312 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6313 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6314 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6318 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6323 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6329 c------------------------------------------------------------------------------
6331 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
6332 implicit real*8 (a-h,o-z)
6333 include 'DIMENSIONS'
6334 integer dimen1,dimen2,atom,indx
6335 double precision buffer(dimen1,dimen2)
6336 double precision zapas
6337 common /contacts_hb/ zapas(3,20,maxres,7),
6338 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6339 & num_cont_hb(maxres),jcont_hb(20,maxres)
6340 num_kont=num_cont_hb(atom)
6344 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
6347 buffer(i,indx+22)=facont_hb(i,atom)
6348 buffer(i,indx+23)=ees0p(i,atom)
6349 buffer(i,indx+24)=ees0m(i,atom)
6350 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
6352 buffer(1,indx+26)=dfloat(num_kont)
6355 c------------------------------------------------------------------------------
6356 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
6357 implicit real*8 (a-h,o-z)
6358 include 'DIMENSIONS'
6359 integer dimen1,dimen2,atom,indx
6360 double precision buffer(dimen1,dimen2)
6361 double precision zapas
6362 common /contacts_hb/ zapas(3,20,maxres,7),
6363 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6364 & num_cont_hb(maxres),jcont_hb(20,maxres)
6365 num_kont=buffer(1,indx+26)
6366 num_kont_old=num_cont_hb(atom)
6367 num_cont_hb(atom)=num_kont+num_kont_old
6372 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
6375 facont_hb(ii,atom)=buffer(i,indx+22)
6376 ees0p(ii,atom)=buffer(i,indx+23)
6377 ees0m(ii,atom)=buffer(i,indx+24)
6378 jcont_hb(ii,atom)=buffer(i,indx+25)
6382 c------------------------------------------------------------------------------
6384 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6385 C This subroutine calculates multi-body contributions to hydrogen-bonding
6386 implicit real*8 (a-h,o-z)
6387 include 'DIMENSIONS'
6388 include 'sizesclu.dat'
6389 include 'COMMON.IOUNITS'
6391 include 'COMMON.INFO'
6393 include 'COMMON.FFIELD'
6394 include 'COMMON.DERIV'
6395 include 'COMMON.INTERACT'
6396 include 'COMMON.CONTACTS'
6398 parameter (max_cont=maxconts)
6399 parameter (max_dim=2*(8*3+2))
6400 parameter (msglen1=max_cont*max_dim*4)
6401 parameter (msglen2=2*msglen1)
6402 integer source,CorrelType,CorrelID,Error
6403 double precision buffer(max_cont,max_dim)
6405 double precision gx(3),gx1(3)
6408 C Set lprn=.true. for debugging
6413 if (fgProcs.le.1) goto 30
6415 write (iout,'(a)') 'Contact function values:'
6417 write (iout,'(2i3,50(1x,i2,f5.2))')
6418 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6419 & j=1,num_cont_hb(i))
6422 C Caution! Following code assumes that electrostatic interactions concerning
6423 C a given atom are split among at most two processors!
6433 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6436 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6437 if (MyRank.gt.0) then
6438 C Send correlation contributions to the preceding processor
6440 nn=num_cont_hb(iatel_s)
6441 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6442 cd write (iout,*) 'The BUFFER array:'
6444 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6446 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6448 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6449 C Clear the contacts of the atom passed to the neighboring processor
6450 nn=num_cont_hb(iatel_s+1)
6452 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6454 num_cont_hb(iatel_s)=0
6456 cd write (iout,*) 'Processor ',MyID,MyRank,
6457 cd & ' is sending correlation contribution to processor',MyID-1,
6458 cd & ' msglen=',msglen
6459 cd write (*,*) 'Processor ',MyID,MyRank,
6460 cd & ' is sending correlation contribution to processor',MyID-1,
6461 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6462 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6463 cd write (iout,*) 'Processor ',MyID,
6464 cd & ' has sent correlation contribution to processor',MyID-1,
6465 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6466 cd write (*,*) 'Processor ',MyID,
6467 cd & ' has sent correlation contribution to processor',MyID-1,
6468 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6470 endif ! (MyRank.gt.0)
6474 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6475 if (MyRank.lt.fgProcs-1) then
6476 C Receive correlation contributions from the next processor
6478 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6479 cd write (iout,*) 'Processor',MyID,
6480 cd & ' is receiving correlation contribution from processor',MyID+1,
6481 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6482 cd write (*,*) 'Processor',MyID,
6483 cd & ' is receiving correlation contribution from processor',MyID+1,
6484 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6486 do while (nbytes.le.0)
6487 call mp_probe(MyID+1,CorrelType,nbytes)
6489 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6490 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6491 cd write (iout,*) 'Processor',MyID,
6492 cd & ' has received correlation contribution from processor',MyID+1,
6493 cd & ' msglen=',msglen,' nbytes=',nbytes
6494 cd write (iout,*) 'The received BUFFER array:'
6496 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6498 if (msglen.eq.msglen1) then
6499 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6500 else if (msglen.eq.msglen2) then
6501 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6502 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6505 & 'ERROR!!!! message length changed while processing correlations.'
6507 & 'ERROR!!!! message length changed while processing correlations.'
6508 call mp_stopall(Error)
6509 endif ! msglen.eq.msglen1
6510 endif ! MyRank.lt.fgProcs-1
6517 write (iout,'(a)') 'Contact function values:'
6519 write (iout,'(2i3,50(1x,i2,f5.2))')
6520 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6521 & j=1,num_cont_hb(i))
6525 C Remove the loop below after debugging !!!
6532 C Calculate the local-electrostatic correlation terms
6533 do i=iatel_s,iatel_e+1
6535 num_conti=num_cont_hb(i)
6536 num_conti1=num_cont_hb(i+1)
6541 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6542 c & ' jj=',jj,' kk=',kk
6543 if (j1.eq.j+1 .or. j1.eq.j-1) then
6544 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6545 C The system gains extra energy.
6546 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6548 else if (j1.eq.j) then
6549 C Contacts I-J and I-(J+1) occur simultaneously.
6550 C The system loses extra energy.
6551 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6556 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6557 c & ' jj=',jj,' kk=',kk
6559 C Contacts I-J and (I+1)-J occur simultaneously.
6560 C The system loses extra energy.
6561 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6568 c------------------------------------------------------------------------------
6569 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6571 C This subroutine calculates multi-body contributions to hydrogen-bonding
6572 implicit real*8 (a-h,o-z)
6573 include 'DIMENSIONS'
6574 include 'sizesclu.dat'
6575 include 'COMMON.IOUNITS'
6577 include 'COMMON.INFO'
6579 include 'COMMON.FFIELD'
6580 include 'COMMON.DERIV'
6581 include 'COMMON.INTERACT'
6582 include 'COMMON.CONTACTS'
6584 parameter (max_cont=maxconts)
6585 parameter (max_dim=2*(8*3+2))
6586 parameter (msglen1=max_cont*max_dim*4)
6587 parameter (msglen2=2*msglen1)
6588 integer source,CorrelType,CorrelID,Error
6589 double precision buffer(max_cont,max_dim)
6591 double precision gx(3),gx1(3)
6594 C Set lprn=.true. for debugging
6600 if (fgProcs.le.1) goto 30
6602 write (iout,'(a)') 'Contact function values:'
6604 write (iout,'(2i3,50(1x,i2,f5.2))')
6605 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6606 & j=1,num_cont_hb(i))
6609 C Caution! Following code assumes that electrostatic interactions concerning
6610 C a given atom are split among at most two processors!
6620 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6623 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6624 if (MyRank.gt.0) then
6625 C Send correlation contributions to the preceding processor
6627 nn=num_cont_hb(iatel_s)
6628 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6629 cd write (iout,*) 'The BUFFER array:'
6631 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6633 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6635 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6636 C Clear the contacts of the atom passed to the neighboring processor
6637 nn=num_cont_hb(iatel_s+1)
6639 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6641 num_cont_hb(iatel_s)=0
6643 cd write (iout,*) 'Processor ',MyID,MyRank,
6644 cd & ' is sending correlation contribution to processor',MyID-1,
6645 cd & ' msglen=',msglen
6646 cd write (*,*) 'Processor ',MyID,MyRank,
6647 cd & ' is sending correlation contribution to processor',MyID-1,
6648 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6649 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6650 cd write (iout,*) 'Processor ',MyID,
6651 cd & ' has sent correlation contribution to processor',MyID-1,
6652 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6653 cd write (*,*) 'Processor ',MyID,
6654 cd & ' has sent correlation contribution to processor',MyID-1,
6655 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6657 endif ! (MyRank.gt.0)
6661 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6662 if (MyRank.lt.fgProcs-1) then
6663 C Receive correlation contributions from the next processor
6665 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6666 cd write (iout,*) 'Processor',MyID,
6667 cd & ' is receiving correlation contribution from processor',MyID+1,
6668 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6669 cd write (*,*) 'Processor',MyID,
6670 cd & ' is receiving correlation contribution from processor',MyID+1,
6671 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6673 do while (nbytes.le.0)
6674 call mp_probe(MyID+1,CorrelType,nbytes)
6676 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6677 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6678 cd write (iout,*) 'Processor',MyID,
6679 cd & ' has received correlation contribution from processor',MyID+1,
6680 cd & ' msglen=',msglen,' nbytes=',nbytes
6681 cd write (iout,*) 'The received BUFFER array:'
6683 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6685 if (msglen.eq.msglen1) then
6686 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6687 else if (msglen.eq.msglen2) then
6688 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6689 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6692 & 'ERROR!!!! message length changed while processing correlations.'
6694 & 'ERROR!!!! message length changed while processing correlations.'
6695 call mp_stopall(Error)
6696 endif ! msglen.eq.msglen1
6697 endif ! MyRank.lt.fgProcs-1
6704 write (iout,'(a)') 'Contact function values:'
6706 write (iout,'(2i3,50(1x,i2,f5.2))')
6707 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6708 & j=1,num_cont_hb(i))
6714 C Remove the loop below after debugging !!!
6721 C Calculate the dipole-dipole interaction energies
6722 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6723 do i=iatel_s,iatel_e+1
6724 num_conti=num_cont_hb(i)
6731 C Calculate the local-electrostatic correlation terms
6732 do i=iatel_s,iatel_e+1
6734 num_conti=num_cont_hb(i)
6735 num_conti1=num_cont_hb(i+1)
6740 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6741 c & ' jj=',jj,' kk=',kk
6742 if (j1.eq.j+1 .or. j1.eq.j-1) then
6743 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6744 C The system gains extra energy.
6746 sqd1=dsqrt(d_cont(jj,i))
6747 sqd2=dsqrt(d_cont(kk,i1))
6748 sred_geom = sqd1*sqd2
6749 IF (sred_geom.lt.cutoff_corr) THEN
6750 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6752 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6753 c & ' jj=',jj,' kk=',kk
6754 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6755 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6757 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6758 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6761 cd write (iout,*) 'sred_geom=',sred_geom,
6762 cd & ' ekont=',ekont,' fprim=',fprimcont
6763 call calc_eello(i,j,i+1,j1,jj,kk)
6764 if (wcorr4.gt.0.0d0)
6765 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6766 if (wcorr5.gt.0.0d0)
6767 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6768 c print *,"wcorr5",ecorr5
6769 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6770 cd write(2,*)'ijkl',i,j,i+1,j1
6771 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6772 & .or. wturn6.eq.0.0d0))then
6773 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6774 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6775 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6776 cd & 'ecorr6=',ecorr6
6777 cd write (iout,'(4e15.5)') sred_geom,
6778 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6779 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6780 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6781 else if (wturn6.gt.0.0d0
6782 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6783 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6784 eturn6=eturn6+eello_turn6(i,jj,kk)
6785 cd write (2,*) 'multibody_eello:eturn6',eturn6
6789 else if (j1.eq.j) then
6790 C Contacts I-J and I-(J+1) occur simultaneously.
6791 C The system loses extra energy.
6792 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6797 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6798 c & ' jj=',jj,' kk=',kk
6800 C Contacts I-J and (I+1)-J occur simultaneously.
6801 C The system loses extra energy.
6802 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6809 c------------------------------------------------------------------------------
6810 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6811 implicit real*8 (a-h,o-z)
6812 include 'DIMENSIONS'
6813 include 'COMMON.IOUNITS'
6814 include 'COMMON.DERIV'
6815 include 'COMMON.INTERACT'
6816 include 'COMMON.CONTACTS'
6817 double precision gx(3),gx1(3)
6827 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6828 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6829 C Following 4 lines for diagnostics.
6834 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6836 c write (iout,*)'Contacts have occurred for peptide groups',
6837 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6838 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6839 C Calculate the multi-body contribution to energy.
6840 ecorr=ecorr+ekont*ees
6842 C Calculate multi-body contributions to the gradient.
6844 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6845 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6846 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6847 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6848 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6849 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6850 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6851 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6852 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6853 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6854 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6855 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6856 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6857 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6861 gradcorr(ll,m)=gradcorr(ll,m)+
6862 & ees*ekl*gacont_hbr(ll,jj,i)-
6863 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6864 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6869 gradcorr(ll,m)=gradcorr(ll,m)+
6870 & ees*eij*gacont_hbr(ll,kk,k)-
6871 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6872 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6879 C---------------------------------------------------------------------------
6880 subroutine dipole(i,j,jj)
6881 implicit real*8 (a-h,o-z)
6882 include 'DIMENSIONS'
6883 include 'sizesclu.dat'
6884 include 'COMMON.IOUNITS'
6885 include 'COMMON.CHAIN'
6886 include 'COMMON.FFIELD'
6887 include 'COMMON.DERIV'
6888 include 'COMMON.INTERACT'
6889 include 'COMMON.CONTACTS'
6890 include 'COMMON.TORSION'
6891 include 'COMMON.VAR'
6892 include 'COMMON.GEO'
6893 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6895 iti1 = itortyp(itype(i+1))
6896 if (j.lt.nres-1) then
6897 itj1 = itortyp(itype(j+1))
6902 dipi(iii,1)=Ub2(iii,i)
6903 dipderi(iii)=Ub2der(iii,i)
6904 dipi(iii,2)=b1(iii,iti1)
6905 dipj(iii,1)=Ub2(iii,j)
6906 dipderj(iii)=Ub2der(iii,j)
6907 dipj(iii,2)=b1(iii,itj1)
6911 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6914 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6917 if (.not.calc_grad) return
6922 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6926 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6931 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6932 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6934 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6936 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6938 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6942 C---------------------------------------------------------------------------
6943 subroutine calc_eello(i,j,k,l,jj,kk)
6945 C This subroutine computes matrices and vectors needed to calculate
6946 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6948 implicit real*8 (a-h,o-z)
6949 include 'DIMENSIONS'
6950 include 'sizesclu.dat'
6951 include 'COMMON.IOUNITS'
6952 include 'COMMON.CHAIN'
6953 include 'COMMON.DERIV'
6954 include 'COMMON.INTERACT'
6955 include 'COMMON.CONTACTS'
6956 include 'COMMON.TORSION'
6957 include 'COMMON.VAR'
6958 include 'COMMON.GEO'
6959 include 'COMMON.FFIELD'
6960 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6961 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6964 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6965 cd & ' jj=',jj,' kk=',kk
6966 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6969 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6970 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6973 call transpose2(aa1(1,1),aa1t(1,1))
6974 call transpose2(aa2(1,1),aa2t(1,1))
6977 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6978 & aa1tder(1,1,lll,kkk))
6979 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6980 & aa2tder(1,1,lll,kkk))
6984 C parallel orientation of the two CA-CA-CA frames.
6986 iti=itortyp(itype(i))
6990 itk1=itortyp(itype(k+1))
6991 itj=itortyp(itype(j))
6992 if (l.lt.nres-1) then
6993 itl1=itortyp(itype(l+1))
6997 C A1 kernel(j+1) A2T
6999 cd write (iout,'(3f10.5,5x,3f10.5)')
7000 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7002 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7003 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7004 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7005 C Following matrices are needed only for 6-th order cumulants
7006 IF (wcorr6.gt.0.0d0) THEN
7007 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7008 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7009 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7010 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7011 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7012 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7013 & ADtEAderx(1,1,1,1,1,1))
7015 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7016 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7017 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7018 & ADtEA1derx(1,1,1,1,1,1))
7020 C End 6-th order cumulants
7023 cd write (2,*) 'In calc_eello6'
7025 cd write (2,*) 'iii=',iii
7027 cd write (2,*) 'kkk=',kkk
7029 cd write (2,'(3(2f10.5),5x)')
7030 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7035 call transpose2(EUgder(1,1,k),auxmat(1,1))
7036 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7037 call transpose2(EUg(1,1,k),auxmat(1,1))
7038 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7039 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7043 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7044 & EAEAderx(1,1,lll,kkk,iii,1))
7048 C A1T kernel(i+1) A2
7049 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7050 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7051 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7052 C Following matrices are needed only for 6-th order cumulants
7053 IF (wcorr6.gt.0.0d0) THEN
7054 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7055 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7056 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(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.,Ug2DtEUg(1,1,k),
7059 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7060 & ADtEAderx(1,1,1,1,1,2))
7061 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7062 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7063 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7064 & ADtEA1derx(1,1,1,1,1,2))
7066 C End 6-th order cumulants
7067 call transpose2(EUgder(1,1,l),auxmat(1,1))
7068 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7069 call transpose2(EUg(1,1,l),auxmat(1,1))
7070 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7071 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7075 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7076 & EAEAderx(1,1,lll,kkk,iii,2))
7081 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7082 C They are needed only when the fifth- or the sixth-order cumulants are
7084 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7085 call transpose2(AEA(1,1,1),auxmat(1,1))
7086 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7087 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7088 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7089 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7090 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7091 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7092 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7093 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7094 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7095 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7096 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7097 call transpose2(AEA(1,1,2),auxmat(1,1))
7098 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7099 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7100 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7101 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7102 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7103 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7104 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7105 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7106 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7107 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7108 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7109 C Calculate the Cartesian derivatives of the vectors.
7113 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7114 call matvec2(auxmat(1,1),b1(1,iti),
7115 & AEAb1derx(1,lll,kkk,iii,1,1))
7116 call matvec2(auxmat(1,1),Ub2(1,i),
7117 & AEAb2derx(1,lll,kkk,iii,1,1))
7118 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7119 & AEAb1derx(1,lll,kkk,iii,2,1))
7120 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7121 & AEAb2derx(1,lll,kkk,iii,2,1))
7122 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7123 call matvec2(auxmat(1,1),b1(1,itj),
7124 & AEAb1derx(1,lll,kkk,iii,1,2))
7125 call matvec2(auxmat(1,1),Ub2(1,j),
7126 & AEAb2derx(1,lll,kkk,iii,1,2))
7127 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7128 & AEAb1derx(1,lll,kkk,iii,2,2))
7129 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7130 & AEAb2derx(1,lll,kkk,iii,2,2))
7137 C Antiparallel orientation of the two CA-CA-CA frames.
7139 iti=itortyp(itype(i))
7143 itk1=itortyp(itype(k+1))
7144 itl=itortyp(itype(l))
7145 itj=itortyp(itype(j))
7146 if (j.lt.nres-1) then
7147 itj1=itortyp(itype(j+1))
7151 C A2 kernel(j-1)T A1T
7152 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7153 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7154 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7155 C Following matrices are needed only for 6-th order cumulants
7156 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7157 & j.eq.i+4 .and. l.eq.i+3)) THEN
7158 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7159 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7160 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7161 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7162 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7163 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7164 & ADtEAderx(1,1,1,1,1,1))
7165 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7166 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7167 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7168 & ADtEA1derx(1,1,1,1,1,1))
7170 C End 6-th order cumulants
7171 call transpose2(EUgder(1,1,k),auxmat(1,1))
7172 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7173 call transpose2(EUg(1,1,k),auxmat(1,1))
7174 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7175 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7179 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7180 & EAEAderx(1,1,lll,kkk,iii,1))
7184 C A2T kernel(i+1)T A1
7185 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7186 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7187 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7188 C Following matrices are needed only for 6-th order cumulants
7189 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7190 & j.eq.i+4 .and. l.eq.i+3)) THEN
7191 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7192 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7193 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(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.,Ug2DtEUg(1,1,k),
7196 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7197 & ADtEAderx(1,1,1,1,1,2))
7198 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7199 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7200 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7201 & ADtEA1derx(1,1,1,1,1,2))
7203 C End 6-th order cumulants
7204 call transpose2(EUgder(1,1,j),auxmat(1,1))
7205 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7206 call transpose2(EUg(1,1,j),auxmat(1,1))
7207 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7208 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7212 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7213 & EAEAderx(1,1,lll,kkk,iii,2))
7218 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7219 C They are needed only when the fifth- or the sixth-order cumulants are
7221 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7222 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7223 call transpose2(AEA(1,1,1),auxmat(1,1))
7224 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7225 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7226 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7227 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7228 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7229 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7230 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7231 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7232 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7233 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7234 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7235 call transpose2(AEA(1,1,2),auxmat(1,1))
7236 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7237 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7238 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7239 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7240 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7241 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7242 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7243 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7244 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7245 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7246 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7247 C Calculate the Cartesian derivatives of the vectors.
7251 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7252 call matvec2(auxmat(1,1),b1(1,iti),
7253 & AEAb1derx(1,lll,kkk,iii,1,1))
7254 call matvec2(auxmat(1,1),Ub2(1,i),
7255 & AEAb2derx(1,lll,kkk,iii,1,1))
7256 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7257 & AEAb1derx(1,lll,kkk,iii,2,1))
7258 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7259 & AEAb2derx(1,lll,kkk,iii,2,1))
7260 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7261 call matvec2(auxmat(1,1),b1(1,itl),
7262 & AEAb1derx(1,lll,kkk,iii,1,2))
7263 call matvec2(auxmat(1,1),Ub2(1,l),
7264 & AEAb2derx(1,lll,kkk,iii,1,2))
7265 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7266 & AEAb1derx(1,lll,kkk,iii,2,2))
7267 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7268 & AEAb2derx(1,lll,kkk,iii,2,2))
7277 C---------------------------------------------------------------------------
7278 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7279 & KK,KKderg,AKA,AKAderg,AKAderx)
7283 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7284 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7285 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7290 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7292 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7295 cd if (lprn) write (2,*) 'In kernel'
7297 cd if (lprn) write (2,*) 'kkk=',kkk
7299 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7300 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7302 cd write (2,*) 'lll=',lll
7303 cd write (2,*) 'iii=1'
7305 cd write (2,'(3(2f10.5),5x)')
7306 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7309 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7310 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7312 cd write (2,*) 'lll=',lll
7313 cd write (2,*) 'iii=2'
7315 cd write (2,'(3(2f10.5),5x)')
7316 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7323 C---------------------------------------------------------------------------
7324 double precision function eello4(i,j,k,l,jj,kk)
7325 implicit real*8 (a-h,o-z)
7326 include 'DIMENSIONS'
7327 include 'sizesclu.dat'
7328 include 'COMMON.IOUNITS'
7329 include 'COMMON.CHAIN'
7330 include 'COMMON.DERIV'
7331 include 'COMMON.INTERACT'
7332 include 'COMMON.CONTACTS'
7333 include 'COMMON.TORSION'
7334 include 'COMMON.VAR'
7335 include 'COMMON.GEO'
7336 double precision pizda(2,2),ggg1(3),ggg2(3)
7337 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7341 cd print *,'eello4:',i,j,k,l,jj,kk
7342 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7343 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7344 cold eij=facont_hb(jj,i)
7345 cold ekl=facont_hb(kk,k)
7347 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7349 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7350 gcorr_loc(k-1)=gcorr_loc(k-1)
7351 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7353 gcorr_loc(l-1)=gcorr_loc(l-1)
7354 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7356 gcorr_loc(j-1)=gcorr_loc(j-1)
7357 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7362 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7363 & -EAEAderx(2,2,lll,kkk,iii,1)
7364 cd derx(lll,kkk,iii)=0.0d0
7368 cd gcorr_loc(l-1)=0.0d0
7369 cd gcorr_loc(j-1)=0.0d0
7370 cd gcorr_loc(k-1)=0.0d0
7372 cd write (iout,*)'Contacts have occurred for peptide groups',
7373 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7374 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7375 if (j.lt.nres-1) then
7382 if (l.lt.nres-1) then
7390 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
7391 ggg1(ll)=eel4*g_contij(ll,1)
7392 ggg2(ll)=eel4*g_contij(ll,2)
7393 ghalf=0.5d0*ggg1(ll)
7395 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
7396 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7397 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
7398 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7399 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
7400 ghalf=0.5d0*ggg2(ll)
7402 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
7403 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7404 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
7405 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7410 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
7411 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7416 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
7417 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7423 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7428 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7432 cd write (2,*) iii,gcorr_loc(iii)
7436 cd write (2,*) 'ekont',ekont
7437 cd write (iout,*) 'eello4',ekont*eel4
7440 C---------------------------------------------------------------------------
7441 double precision function eello5(i,j,k,l,jj,kk)
7442 implicit real*8 (a-h,o-z)
7443 include 'DIMENSIONS'
7444 include 'sizesclu.dat'
7445 include 'COMMON.IOUNITS'
7446 include 'COMMON.CHAIN'
7447 include 'COMMON.DERIV'
7448 include 'COMMON.INTERACT'
7449 include 'COMMON.CONTACTS'
7450 include 'COMMON.TORSION'
7451 include 'COMMON.VAR'
7452 include 'COMMON.GEO'
7453 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7454 double precision ggg1(3),ggg2(3)
7455 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7460 C /l\ / \ \ / \ / \ / C
7461 C / \ / \ \ / \ / \ / C
7462 C j| o |l1 | o | o| o | | o |o C
7463 C \ |/k\| |/ \| / |/ \| |/ \| C
7464 C \i/ \ / \ / / \ / \ C
7466 C (I) (II) (III) (IV) C
7468 C eello5_1 eello5_2 eello5_3 eello5_4 C
7470 C Antiparallel chains C
7473 C /j\ / \ \ / \ / \ / C
7474 C / \ / \ \ / \ / \ / C
7475 C j1| o |l | o | o| o | | o |o C
7476 C \ |/k\| |/ \| / |/ \| |/ \| C
7477 C \i/ \ / \ / / \ / \ C
7479 C (I) (II) (III) (IV) C
7481 C eello5_1 eello5_2 eello5_3 eello5_4 C
7483 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7485 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7486 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7491 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7493 itk=itortyp(itype(k))
7494 itl=itortyp(itype(l))
7495 itj=itortyp(itype(j))
7500 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7501 cd & eel5_3_num,eel5_4_num)
7505 derx(lll,kkk,iii)=0.0d0
7509 cd eij=facont_hb(jj,i)
7510 cd ekl=facont_hb(kk,k)
7512 cd write (iout,*)'Contacts have occurred for peptide groups',
7513 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7515 C Contribution from the graph I.
7516 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7517 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7518 call transpose2(EUg(1,1,k),auxmat(1,1))
7519 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7520 vv(1)=pizda(1,1)-pizda(2,2)
7521 vv(2)=pizda(1,2)+pizda(2,1)
7522 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7523 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7525 C Explicit gradient in virtual-dihedral angles.
7526 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7527 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7528 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7529 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7530 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7531 vv(1)=pizda(1,1)-pizda(2,2)
7532 vv(2)=pizda(1,2)+pizda(2,1)
7533 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7534 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7535 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7536 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7537 vv(1)=pizda(1,1)-pizda(2,2)
7538 vv(2)=pizda(1,2)+pizda(2,1)
7540 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7541 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7542 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7544 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7545 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7546 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7548 C Cartesian gradient
7552 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7554 vv(1)=pizda(1,1)-pizda(2,2)
7555 vv(2)=pizda(1,2)+pizda(2,1)
7556 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7557 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7558 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7565 C Contribution from graph II
7566 call transpose2(EE(1,1,itk),auxmat(1,1))
7567 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7568 vv(1)=pizda(1,1)+pizda(2,2)
7569 vv(2)=pizda(2,1)-pizda(1,2)
7570 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7571 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7573 C Explicit gradient in virtual-dihedral angles.
7574 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7575 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7576 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7577 vv(1)=pizda(1,1)+pizda(2,2)
7578 vv(2)=pizda(2,1)-pizda(1,2)
7580 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7581 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7582 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7584 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7585 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7586 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7588 C Cartesian gradient
7592 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7594 vv(1)=pizda(1,1)+pizda(2,2)
7595 vv(2)=pizda(2,1)-pizda(1,2)
7596 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7597 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7598 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7607 C Parallel orientation
7608 C Contribution from graph III
7609 call transpose2(EUg(1,1,l),auxmat(1,1))
7610 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7611 vv(1)=pizda(1,1)-pizda(2,2)
7612 vv(2)=pizda(1,2)+pizda(2,1)
7613 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7614 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7616 C Explicit gradient in virtual-dihedral angles.
7617 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7618 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7619 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7620 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7621 vv(1)=pizda(1,1)-pizda(2,2)
7622 vv(2)=pizda(1,2)+pizda(2,1)
7623 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7624 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7625 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7626 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7627 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7628 vv(1)=pizda(1,1)-pizda(2,2)
7629 vv(2)=pizda(1,2)+pizda(2,1)
7630 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7631 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7632 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7633 C Cartesian gradient
7637 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7639 vv(1)=pizda(1,1)-pizda(2,2)
7640 vv(2)=pizda(1,2)+pizda(2,1)
7641 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7642 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7643 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7649 C Contribution from graph IV
7651 call transpose2(EE(1,1,itl),auxmat(1,1))
7652 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7653 vv(1)=pizda(1,1)+pizda(2,2)
7654 vv(2)=pizda(2,1)-pizda(1,2)
7655 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7656 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7658 C Explicit gradient in virtual-dihedral angles.
7659 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7660 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7661 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7662 vv(1)=pizda(1,1)+pizda(2,2)
7663 vv(2)=pizda(2,1)-pizda(1,2)
7664 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7665 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7666 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7667 C Cartesian gradient
7671 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7673 vv(1)=pizda(1,1)+pizda(2,2)
7674 vv(2)=pizda(2,1)-pizda(1,2)
7675 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7676 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7677 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7683 C Antiparallel orientation
7684 C Contribution from graph III
7686 call transpose2(EUg(1,1,j),auxmat(1,1))
7687 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7688 vv(1)=pizda(1,1)-pizda(2,2)
7689 vv(2)=pizda(1,2)+pizda(2,1)
7690 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7691 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7693 C Explicit gradient in virtual-dihedral angles.
7694 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7695 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7696 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7697 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7698 vv(1)=pizda(1,1)-pizda(2,2)
7699 vv(2)=pizda(1,2)+pizda(2,1)
7700 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7701 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7702 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7703 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7704 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7705 vv(1)=pizda(1,1)-pizda(2,2)
7706 vv(2)=pizda(1,2)+pizda(2,1)
7707 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7708 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7709 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7710 C Cartesian gradient
7714 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7716 vv(1)=pizda(1,1)-pizda(2,2)
7717 vv(2)=pizda(1,2)+pizda(2,1)
7718 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7719 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7720 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7726 C Contribution from graph IV
7728 call transpose2(EE(1,1,itj),auxmat(1,1))
7729 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7730 vv(1)=pizda(1,1)+pizda(2,2)
7731 vv(2)=pizda(2,1)-pizda(1,2)
7732 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7733 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7735 C Explicit gradient in virtual-dihedral angles.
7736 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7737 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7738 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7739 vv(1)=pizda(1,1)+pizda(2,2)
7740 vv(2)=pizda(2,1)-pizda(1,2)
7741 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7742 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7743 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7744 C Cartesian gradient
7748 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7750 vv(1)=pizda(1,1)+pizda(2,2)
7751 vv(2)=pizda(2,1)-pizda(1,2)
7752 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7753 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7754 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7761 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7762 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7763 cd write (2,*) 'ijkl',i,j,k,l
7764 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7765 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7767 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7768 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7769 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7770 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7772 if (j.lt.nres-1) then
7779 if (l.lt.nres-1) then
7789 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7791 ggg1(ll)=eel5*g_contij(ll,1)
7792 ggg2(ll)=eel5*g_contij(ll,2)
7793 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7794 ghalf=0.5d0*ggg1(ll)
7796 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7797 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7798 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7799 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7800 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7801 ghalf=0.5d0*ggg2(ll)
7803 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7804 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7805 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7806 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7811 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7812 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7817 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7818 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7824 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7829 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7833 cd write (2,*) iii,g_corr5_loc(iii)
7837 cd write (2,*) 'ekont',ekont
7838 cd write (iout,*) 'eello5',ekont*eel5
7841 c--------------------------------------------------------------------------
7842 double precision function eello6(i,j,k,l,jj,kk)
7843 implicit real*8 (a-h,o-z)
7844 include 'DIMENSIONS'
7845 include 'sizesclu.dat'
7846 include 'COMMON.IOUNITS'
7847 include 'COMMON.CHAIN'
7848 include 'COMMON.DERIV'
7849 include 'COMMON.INTERACT'
7850 include 'COMMON.CONTACTS'
7851 include 'COMMON.TORSION'
7852 include 'COMMON.VAR'
7853 include 'COMMON.GEO'
7854 include 'COMMON.FFIELD'
7855 double precision ggg1(3),ggg2(3)
7856 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7861 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7869 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7870 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7874 derx(lll,kkk,iii)=0.0d0
7878 cd eij=facont_hb(jj,i)
7879 cd ekl=facont_hb(kk,k)
7885 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7886 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7887 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7888 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7889 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7890 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7892 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7893 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7894 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7895 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7896 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7897 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7901 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7903 C If turn contributions are considered, they will be handled separately.
7904 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7905 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7906 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7907 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7908 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7909 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7910 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7913 if (j.lt.nres-1) then
7920 if (l.lt.nres-1) then
7928 ggg1(ll)=eel6*g_contij(ll,1)
7929 ggg2(ll)=eel6*g_contij(ll,2)
7930 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7931 ghalf=0.5d0*ggg1(ll)
7933 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7934 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7935 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7936 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7937 ghalf=0.5d0*ggg2(ll)
7938 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7940 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7941 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7942 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7943 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7948 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7949 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7954 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7955 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7961 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7966 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7970 cd write (2,*) iii,g_corr6_loc(iii)
7974 cd write (2,*) 'ekont',ekont
7975 cd write (iout,*) 'eello6',ekont*eel6
7978 c--------------------------------------------------------------------------
7979 double precision function eello6_graph1(i,j,k,l,imat,swap)
7980 implicit real*8 (a-h,o-z)
7981 include 'DIMENSIONS'
7982 include 'sizesclu.dat'
7983 include 'COMMON.IOUNITS'
7984 include 'COMMON.CHAIN'
7985 include 'COMMON.DERIV'
7986 include 'COMMON.INTERACT'
7987 include 'COMMON.CONTACTS'
7988 include 'COMMON.TORSION'
7989 include 'COMMON.VAR'
7990 include 'COMMON.GEO'
7991 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7995 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7997 C Parallel Antiparallel C
8003 C \ j|/k\| / \ |/k\|l / C
8008 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8009 itk=itortyp(itype(k))
8010 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8011 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8012 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8013 call transpose2(EUgC(1,1,k),auxmat(1,1))
8014 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8015 vv1(1)=pizda1(1,1)-pizda1(2,2)
8016 vv1(2)=pizda1(1,2)+pizda1(2,1)
8017 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8018 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8019 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8020 s5=scalar2(vv(1),Dtobr2(1,i))
8021 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8022 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8023 if (.not. calc_grad) return
8024 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8025 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8026 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8027 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8028 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8029 & +scalar2(vv(1),Dtobr2der(1,i)))
8030 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8031 vv1(1)=pizda1(1,1)-pizda1(2,2)
8032 vv1(2)=pizda1(1,2)+pizda1(2,1)
8033 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8034 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8036 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8037 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8038 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8039 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8040 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8042 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8043 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8044 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8045 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8046 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8048 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8049 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8050 vv1(1)=pizda1(1,1)-pizda1(2,2)
8051 vv1(2)=pizda1(1,2)+pizda1(2,1)
8052 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8053 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8054 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8055 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8064 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8065 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8066 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8067 call transpose2(EUgC(1,1,k),auxmat(1,1))
8068 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8070 vv1(1)=pizda1(1,1)-pizda1(2,2)
8071 vv1(2)=pizda1(1,2)+pizda1(2,1)
8072 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8073 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8074 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8075 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8076 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8077 s5=scalar2(vv(1),Dtobr2(1,i))
8078 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8084 c----------------------------------------------------------------------------
8085 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8086 implicit real*8 (a-h,o-z)
8087 include 'DIMENSIONS'
8088 include 'sizesclu.dat'
8089 include 'COMMON.IOUNITS'
8090 include 'COMMON.CHAIN'
8091 include 'COMMON.DERIV'
8092 include 'COMMON.INTERACT'
8093 include 'COMMON.CONTACTS'
8094 include 'COMMON.TORSION'
8095 include 'COMMON.VAR'
8096 include 'COMMON.GEO'
8098 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8099 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8102 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8104 C Parallel Antiparallel C
8110 C \ j|/k\| \ |/k\|l C
8115 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8116 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8117 C AL 7/4/01 s1 would occur in the sixth-order moment,
8118 C but not in a cluster cumulant
8120 s1=dip(1,jj,i)*dip(1,kk,k)
8122 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8123 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8124 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8125 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8126 call transpose2(EUg(1,1,k),auxmat(1,1))
8127 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8128 vv(1)=pizda(1,1)-pizda(2,2)
8129 vv(2)=pizda(1,2)+pizda(2,1)
8130 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8131 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8133 eello6_graph2=-(s1+s2+s3+s4)
8135 eello6_graph2=-(s2+s3+s4)
8138 if (.not. calc_grad) return
8139 C Derivatives in gamma(i-1)
8142 s1=dipderg(1,jj,i)*dip(1,kk,k)
8144 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8145 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8146 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8147 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8149 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8151 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8153 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8155 C Derivatives in gamma(k-1)
8157 s1=dip(1,jj,i)*dipderg(1,kk,k)
8159 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8160 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8161 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8162 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8163 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8164 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8165 vv(1)=pizda(1,1)-pizda(2,2)
8166 vv(2)=pizda(1,2)+pizda(2,1)
8167 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8169 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8171 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8173 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8174 C Derivatives in gamma(j-1) or gamma(l-1)
8177 s1=dipderg(3,jj,i)*dip(1,kk,k)
8179 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8180 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8181 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8182 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8183 vv(1)=pizda(1,1)-pizda(2,2)
8184 vv(2)=pizda(1,2)+pizda(2,1)
8185 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8188 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8190 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8193 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8194 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8196 C Derivatives in gamma(l-1) or gamma(j-1)
8199 s1=dip(1,jj,i)*dipderg(3,kk,k)
8201 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8202 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8203 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8204 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8205 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8206 vv(1)=pizda(1,1)-pizda(2,2)
8207 vv(2)=pizda(1,2)+pizda(2,1)
8208 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8211 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8213 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8216 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8217 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8219 C Cartesian derivatives.
8221 write (2,*) 'In eello6_graph2'
8223 write (2,*) 'iii=',iii
8225 write (2,*) 'kkk=',kkk
8227 write (2,'(3(2f10.5),5x)')
8228 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8238 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8240 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8243 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8245 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8246 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8248 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8249 call transpose2(EUg(1,1,k),auxmat(1,1))
8250 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8252 vv(1)=pizda(1,1)-pizda(2,2)
8253 vv(2)=pizda(1,2)+pizda(2,1)
8254 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8255 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8257 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8259 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8262 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8264 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8271 c----------------------------------------------------------------------------
8272 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8273 implicit real*8 (a-h,o-z)
8274 include 'DIMENSIONS'
8275 include 'sizesclu.dat'
8276 include 'COMMON.IOUNITS'
8277 include 'COMMON.CHAIN'
8278 include 'COMMON.DERIV'
8279 include 'COMMON.INTERACT'
8280 include 'COMMON.CONTACTS'
8281 include 'COMMON.TORSION'
8282 include 'COMMON.VAR'
8283 include 'COMMON.GEO'
8284 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8286 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8288 C Parallel Antiparallel C
8294 C j|/k\| / |/k\|l / C
8299 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8301 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8302 C energy moment and not to the cluster cumulant.
8303 iti=itortyp(itype(i))
8304 if (j.lt.nres-1) then
8305 itj1=itortyp(itype(j+1))
8309 itk=itortyp(itype(k))
8310 itk1=itortyp(itype(k+1))
8311 if (l.lt.nres-1) then
8312 itl1=itortyp(itype(l+1))
8317 s1=dip(4,jj,i)*dip(4,kk,k)
8319 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8320 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8321 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8322 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8323 call transpose2(EE(1,1,itk),auxmat(1,1))
8324 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8325 vv(1)=pizda(1,1)+pizda(2,2)
8326 vv(2)=pizda(2,1)-pizda(1,2)
8327 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8328 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8330 eello6_graph3=-(s1+s2+s3+s4)
8332 eello6_graph3=-(s2+s3+s4)
8335 if (.not. calc_grad) return
8336 C Derivatives in gamma(k-1)
8337 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8338 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8339 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8340 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8341 C Derivatives in gamma(l-1)
8342 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8343 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8344 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8345 vv(1)=pizda(1,1)+pizda(2,2)
8346 vv(2)=pizda(2,1)-pizda(1,2)
8347 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8348 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8349 C Cartesian derivatives.
8355 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8357 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8360 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8362 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8363 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8365 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8366 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8368 vv(1)=pizda(1,1)+pizda(2,2)
8369 vv(2)=pizda(2,1)-pizda(1,2)
8370 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8372 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8374 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8377 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8379 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8381 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8387 c----------------------------------------------------------------------------
8388 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8389 implicit real*8 (a-h,o-z)
8390 include 'DIMENSIONS'
8391 include 'sizesclu.dat'
8392 include 'COMMON.IOUNITS'
8393 include 'COMMON.CHAIN'
8394 include 'COMMON.DERIV'
8395 include 'COMMON.INTERACT'
8396 include 'COMMON.CONTACTS'
8397 include 'COMMON.TORSION'
8398 include 'COMMON.VAR'
8399 include 'COMMON.GEO'
8400 include 'COMMON.FFIELD'
8401 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8402 & auxvec1(2),auxmat1(2,2)
8404 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8406 C Parallel Antiparallel C
8412 C \ j|/k\| \ |/k\|l C
8417 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8419 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8420 C energy moment and not to the cluster cumulant.
8421 cd write (2,*) 'eello_graph4: wturn6',wturn6
8422 iti=itortyp(itype(i))
8423 itj=itortyp(itype(j))
8424 if (j.lt.nres-1) then
8425 itj1=itortyp(itype(j+1))
8429 itk=itortyp(itype(k))
8430 if (k.lt.nres-1) then
8431 itk1=itortyp(itype(k+1))
8435 itl=itortyp(itype(l))
8436 if (l.lt.nres-1) then
8437 itl1=itortyp(itype(l+1))
8441 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8442 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8443 cd & ' itl',itl,' itl1',itl1
8446 s1=dip(3,jj,i)*dip(3,kk,k)
8448 s1=dip(2,jj,j)*dip(2,kk,l)
8451 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8452 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8454 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8455 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8457 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8458 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8460 call transpose2(EUg(1,1,k),auxmat(1,1))
8461 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8462 vv(1)=pizda(1,1)-pizda(2,2)
8463 vv(2)=pizda(2,1)+pizda(1,2)
8464 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8465 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8467 eello6_graph4=-(s1+s2+s3+s4)
8469 eello6_graph4=-(s2+s3+s4)
8471 if (.not. calc_grad) return
8472 C Derivatives in gamma(i-1)
8476 s1=dipderg(2,jj,i)*dip(3,kk,k)
8478 s1=dipderg(4,jj,j)*dip(2,kk,l)
8481 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8483 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8484 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8486 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8487 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8489 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8490 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8491 cd write (2,*) 'turn6 derivatives'
8493 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8495 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8499 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8501 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8505 C Derivatives in gamma(k-1)
8508 s1=dip(3,jj,i)*dipderg(2,kk,k)
8510 s1=dip(2,jj,j)*dipderg(4,kk,l)
8513 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8514 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8516 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8517 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8519 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8520 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8522 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8523 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8524 vv(1)=pizda(1,1)-pizda(2,2)
8525 vv(2)=pizda(2,1)+pizda(1,2)
8526 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8527 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8529 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8531 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8535 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8537 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8540 C Derivatives in gamma(j-1) or gamma(l-1)
8541 if (l.eq.j+1 .and. l.gt.1) then
8542 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8543 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8544 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8545 vv(1)=pizda(1,1)-pizda(2,2)
8546 vv(2)=pizda(2,1)+pizda(1,2)
8547 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8548 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8549 else if (j.gt.1) then
8550 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8551 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8552 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8553 vv(1)=pizda(1,1)-pizda(2,2)
8554 vv(2)=pizda(2,1)+pizda(1,2)
8555 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8556 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8557 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8559 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8562 C Cartesian derivatives.
8569 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8571 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8575 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8577 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8581 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8583 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8585 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8586 & b1(1,itj1),auxvec(1))
8587 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8589 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8590 & b1(1,itl1),auxvec(1))
8591 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8593 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8595 vv(1)=pizda(1,1)-pizda(2,2)
8596 vv(2)=pizda(2,1)+pizda(1,2)
8597 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8599 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8601 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8604 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8607 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8610 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8612 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8614 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8618 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8620 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8623 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8625 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8633 c----------------------------------------------------------------------------
8634 double precision function eello_turn6(i,jj,kk)
8635 implicit real*8 (a-h,o-z)
8636 include 'DIMENSIONS'
8637 include 'sizesclu.dat'
8638 include 'COMMON.IOUNITS'
8639 include 'COMMON.CHAIN'
8640 include 'COMMON.DERIV'
8641 include 'COMMON.INTERACT'
8642 include 'COMMON.CONTACTS'
8643 include 'COMMON.TORSION'
8644 include 'COMMON.VAR'
8645 include 'COMMON.GEO'
8646 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8647 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8649 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8650 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8651 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8652 C the respective energy moment and not to the cluster cumulant.
8657 iti=itortyp(itype(i))
8658 itk=itortyp(itype(k))
8659 itk1=itortyp(itype(k+1))
8660 itl=itortyp(itype(l))
8661 itj=itortyp(itype(j))
8662 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8663 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8664 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8669 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8671 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8675 derx_turn(lll,kkk,iii)=0.0d0
8682 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8684 cd write (2,*) 'eello6_5',eello6_5
8686 call transpose2(AEA(1,1,1),auxmat(1,1))
8687 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8688 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8689 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8693 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8694 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8695 s2 = scalar2(b1(1,itk),vtemp1(1))
8697 call transpose2(AEA(1,1,2),atemp(1,1))
8698 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8699 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8700 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8704 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8705 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8706 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8708 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8709 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8710 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8711 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8712 ss13 = scalar2(b1(1,itk),vtemp4(1))
8713 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8717 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8723 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8725 C Derivatives in gamma(i+2)
8727 call transpose2(AEA(1,1,1),auxmatd(1,1))
8728 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8729 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8730 call transpose2(AEAderg(1,1,2),atempd(1,1))
8731 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8732 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8736 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8737 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8738 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8744 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8745 C Derivatives in gamma(i+3)
8747 call transpose2(AEA(1,1,1),auxmatd(1,1))
8748 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8749 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8750 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8754 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8755 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8756 s2d = scalar2(b1(1,itk),vtemp1d(1))
8758 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8759 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8761 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8763 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8764 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8765 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8775 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8776 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8778 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8779 & -0.5d0*ekont*(s2d+s12d)
8781 C Derivatives in gamma(i+4)
8782 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8783 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8784 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8786 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8787 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8788 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8798 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8800 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8802 C Derivatives in gamma(i+5)
8804 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8805 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8806 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8810 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8811 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8812 s2d = scalar2(b1(1,itk),vtemp1d(1))
8814 call transpose2(AEA(1,1,2),atempd(1,1))
8815 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8816 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8820 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8821 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8823 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8824 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8825 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8835 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8836 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8838 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8839 & -0.5d0*ekont*(s2d+s12d)
8841 C Cartesian derivatives
8846 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8847 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8848 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8852 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8853 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8855 s2d = scalar2(b1(1,itk),vtemp1d(1))
8857 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8858 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8859 s8d = -(atempd(1,1)+atempd(2,2))*
8860 & scalar2(cc(1,1,itl),vtemp2(1))
8864 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8866 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8867 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8874 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8877 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8881 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8882 & - 0.5d0*(s8d+s12d)
8884 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8893 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8895 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8896 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8897 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8898 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8899 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8901 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8902 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8903 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8907 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8908 cd & 16*eel_turn6_num
8910 if (j.lt.nres-1) then
8917 if (l.lt.nres-1) then
8925 ggg1(ll)=eel_turn6*g_contij(ll,1)
8926 ggg2(ll)=eel_turn6*g_contij(ll,2)
8927 ghalf=0.5d0*ggg1(ll)
8929 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8930 & +ekont*derx_turn(ll,2,1)
8931 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8932 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8933 & +ekont*derx_turn(ll,4,1)
8934 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8935 ghalf=0.5d0*ggg2(ll)
8937 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8938 & +ekont*derx_turn(ll,2,2)
8939 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8940 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8941 & +ekont*derx_turn(ll,4,2)
8942 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8947 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8952 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8958 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8963 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8967 cd write (2,*) iii,g_corr6_loc(iii)
8970 eello_turn6=ekont*eel_turn6
8971 cd write (2,*) 'ekont',ekont
8972 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8975 crc-------------------------------------------------
8976 SUBROUTINE MATVEC2(A1,V1,V2)
8977 implicit real*8 (a-h,o-z)
8978 include 'DIMENSIONS'
8979 DIMENSION A1(2,2),V1(2),V2(2)
8983 c 3 VI=VI+A1(I,K)*V1(K)
8987 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8988 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8993 C---------------------------------------
8994 SUBROUTINE MATMAT2(A1,A2,A3)
8995 implicit real*8 (a-h,o-z)
8996 include 'DIMENSIONS'
8997 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8998 c DIMENSION AI3(2,2)
9002 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9008 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9009 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9010 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9011 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9019 c-------------------------------------------------------------------------
9020 double precision function scalar2(u,v)
9022 double precision u(2),v(2)
9025 scalar2=u(1)*v(1)+u(2)*v(2)
9029 C-----------------------------------------------------------------------------
9031 subroutine transpose2(a,at)
9033 double precision a(2,2),at(2,2)
9040 c--------------------------------------------------------------------------
9041 subroutine transpose(n,a,at)
9044 double precision a(n,n),at(n,n)
9052 C---------------------------------------------------------------------------
9053 subroutine prodmat3(a1,a2,kk,transp,prod)
9056 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9058 crc double precision auxmat(2,2),prod_(2,2)
9061 crc call transpose2(kk(1,1),auxmat(1,1))
9062 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9063 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9065 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9066 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9067 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9068 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9069 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9070 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9071 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9072 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9075 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9076 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9078 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9079 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9080 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9081 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9082 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9083 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9084 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9085 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9088 c call transpose2(a2(1,1),a2t(1,1))
9091 crc print *,((prod_(i,j),i=1,2),j=1,2)
9092 crc print *,((prod(i,j),i=1,2),j=1,2)
9096 C-----------------------------------------------------------------------------
9097 double precision function scalar(u,v)
9099 double precision u(3),v(3)