1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
8 cMS$ATTRIBUTES C :: proc_proc
11 include 'COMMON.IOUNITS'
12 double precision energia(0:max_ene),energia1(0:max_ene+1)
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
23 double precision fact(5)
24 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
25 cd print *,'nnt=',nnt,' nct=',nct
27 C Compute the side-chain and electrostatic interaction energy
29 goto (101,102,103,104,105) ipot
30 C Lennard-Jones potential.
32 cd print '(a)','Exit ELJ'
34 C Lennard-Jones-Kihara potential (shifted).
37 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 C Gay-Berne potential (shifted LJ, angular dependence).
43 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 C Calculate electrostatic (H-bonding) energy of the main chain.
48 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
50 C Calculate excluded-volume interaction energy between peptide groups
53 call escp(evdw2,evdw2_14)
55 c Calculate the bond-stretching energy
58 c write (iout,*) "estr",estr
60 C Calculate the disulfide-bridge and other energy and the contributions
61 C from other distance constraints.
62 cd print *,'Calling EHPB'
64 cd print *,'EHPB exitted succesfully.'
66 C Calculate the virtual-bond-angle energy.
69 cd print *,'Bend energy finished.'
71 C Calculate the SC local energy.
74 cd print *,'SCLOC energy finished.'
76 C Calculate the virtual-bond torsional energy.
78 cd print *,'nterm=',nterm
79 call etor(etors,edihcnstr,fact(1))
81 C 6/23/01 Calculate double-torsional energy
83 call etor_d(etors_d,fact(2))
85 C 21/5/07 Calculate local sicdechain correlation energy
87 call eback_sc_corr(esccor,fact(1))
89 C 12/1/95 Multi-body terms
93 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
94 & .or. wturn6.gt.0.0d0) then
95 c print *,"calling multibody_eello"
96 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
97 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
98 c print *,ecorr,ecorr5,ecorr6,eturn6
100 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
101 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
103 C call multibody(ecorr)
108 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*ees+wvdwpp*evdw1
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*(ees+evdw1)
117 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
118 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
119 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
120 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
121 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
122 & +wbond*estr+wsccor*fact(1)*esccor
127 energia(2)=evdw2-evdw2_14
144 energia(8)=eello_turn3
145 energia(9)=eello_turn4
154 energia(20)=edihcnstr
158 idumm=proc_proc(etot,i)
160 call proc_proc(etot,i)
162 if(i.eq.1)energia(0)=1.0d+99
168 C Sum up the components of the Cartesian gradient.
173 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
174 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
176 & wstrain*ghpbc(j,i)+
177 & wcorr*fact(3)*gradcorr(j,i)+
178 & wel_loc*fact(2)*gel_loc(j,i)+
179 & wturn3*fact(2)*gcorr3_turn(j,i)+
180 & wturn4*fact(3)*gcorr4_turn(j,i)+
181 & wcorr5*fact(4)*gradcorr5(j,i)+
182 & wcorr6*fact(5)*gradcorr6(j,i)+
183 & wturn6*fact(5)*gcorr6_turn(j,i)+
184 & wsccor*fact(2)*gsccorc(j,i)
185 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
187 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
192 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
193 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
195 & wcorr*fact(3)*gradcorr(j,i)+
196 & wel_loc*fact(2)*gel_loc(j,i)+
197 & wturn3*fact(2)*gcorr3_turn(j,i)+
198 & wturn4*fact(3)*gcorr4_turn(j,i)+
199 & wcorr5*fact(4)*gradcorr5(j,i)+
200 & wcorr6*fact(5)*gradcorr6(j,i)+
201 & wturn6*fact(5)*gcorr6_turn(j,i)+
202 & wsccor*fact(2)*gsccorc(j,i)
203 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
205 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
208 cd print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3),
209 cd & (gradc(k,i),k=1,3)
214 cd write (iout,*) i,g_corr5_loc(i)
215 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
216 & +wcorr5*fact(4)*g_corr5_loc(i)
217 & +wcorr6*fact(5)*g_corr6_loc(i)
218 & +wturn4*fact(3)*gel_loc_turn4(i)
219 & +wturn3*fact(2)*gel_loc_turn3(i)
220 & +wturn6*fact(5)*gel_loc_turn6(i)
221 & +wel_loc*fact(2)*gel_loc_loc(i)+
222 & +wsccor*fact(1)*gsccor_loc(i)
225 cd call enerprint(energia(0),fact)
230 C------------------------------------------------------------------------
231 subroutine enerprint(energia,fact)
232 implicit real*8 (a-h,o-z)
234 include 'sizesclu.dat'
235 include 'COMMON.IOUNITS'
236 include 'COMMON.FFIELD'
237 include 'COMMON.SBRIDGE'
238 double precision energia(0:max_ene),fact(5)
242 evdw2=energia(2)+energia(17)
254 eello_turn3=energia(8)
255 eello_turn4=energia(9)
256 eello_turn6=energia(10)
263 edihcnstr=energia(20)
266 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
268 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
269 & etors_d,wtor_d*fact(2),ehpb,wstrain,
270 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
271 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
272 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
273 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
274 10 format (/'Virtual-chain energies:'//
275 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
276 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
277 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
278 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
279 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
280 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
281 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
282 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
283 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
284 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
285 & ' (SS bridges & dist. cnstr.)'/
286 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
287 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
288 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
289 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
290 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
291 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
292 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
293 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
294 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
295 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
296 & 'ETOT= ',1pE16.6,' (total)')
298 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
299 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
300 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
301 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
302 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
303 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
304 & edihcnstr,ebr*nss,etot
305 10 format (/'Virtual-chain energies:'//
306 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
307 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
308 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
309 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
310 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
311 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
312 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
313 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
314 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
315 & ' (SS bridges & dist. cnstr.)'/
316 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
317 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
318 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
319 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
320 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
321 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
322 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
323 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
324 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
325 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
326 & 'ETOT= ',1pE16.6,' (total)')
330 C-----------------------------------------------------------------------
333 C This subroutine calculates the interaction energy of nonbonded side chains
334 C assuming the LJ potential of interaction.
336 implicit real*8 (a-h,o-z)
338 include 'sizesclu.dat'
339 c include "DIMENSIONS.COMPAR"
340 parameter (accur=1.0d-10)
343 include 'COMMON.LOCAL'
344 include 'COMMON.CHAIN'
345 include 'COMMON.DERIV'
346 include 'COMMON.INTERACT'
347 include 'COMMON.TORSION'
348 include 'COMMON.SBRIDGE'
349 include 'COMMON.NAMES'
350 include 'COMMON.IOUNITS'
351 include 'COMMON.CONTACTS'
355 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
366 C Calculate SC interaction energy.
369 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
370 cd & 'iend=',iend(i,iint)
371 do j=istart(i,iint),iend(i,iint)
376 C Change 12/1/95 to calculate four-body interactions
377 rij=xj*xj+yj*yj+zj*zj
379 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
380 eps0ij=eps(itypi,itypj)
382 e1=fac*fac*aa(itypi,itypj)
383 e2=fac*bb(itypi,itypj)
385 ij=icant(itypi,itypj)
386 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
387 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
388 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
389 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
390 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
391 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
395 C Calculate the components of the gradient in DC and X
397 fac=-rrij*(e1+evdwij)
402 gvdwx(k,i)=gvdwx(k,i)-gg(k)
403 gvdwx(k,j)=gvdwx(k,j)+gg(k)
407 gvdwc(l,k)=gvdwc(l,k)+gg(l)
412 C 12/1/95, revised on 5/20/97
414 C Calculate the contact function. The ith column of the array JCONT will
415 C contain the numbers of atoms that make contacts with the atom I (of numbers
416 C greater than I). The arrays FACONT and GACONT will contain the values of
417 C the contact function and its derivative.
419 C Uncomment next line, if the correlation interactions include EVDW explicitly.
420 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
421 C Uncomment next line, if the correlation interactions are contact function only
422 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
424 sigij=sigma(itypi,itypj)
425 r0ij=rs0(itypi,itypj)
427 C Check whether the SC's are not too far to make a contact.
430 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
431 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
433 if (fcont.gt.0.0D0) then
434 C If the SC-SC distance if close to sigma, apply spline.
435 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
436 cAdam & fcont1,fprimcont1)
437 cAdam fcont1=1.0d0-fcont1
438 cAdam if (fcont1.gt.0.0d0) then
439 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
440 cAdam fcont=fcont*fcont1
442 C Uncomment following 4 lines to have the geometric average of the epsilon0's
443 cga eps0ij=1.0d0/dsqrt(eps0ij)
445 cga gg(k)=gg(k)*eps0ij
447 cga eps0ij=-evdwij*eps0ij
448 C Uncomment for AL's type of SC correlation interactions.
450 num_conti=num_conti+1
452 facont(num_conti,i)=fcont*eps0ij
453 fprimcont=eps0ij*fprimcont/rij
455 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
456 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
457 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
458 C Uncomment following 3 lines for Skolnick's type of SC correlation.
459 gacont(1,num_conti,i)=-fprimcont*xj
460 gacont(2,num_conti,i)=-fprimcont*yj
461 gacont(3,num_conti,i)=-fprimcont*zj
462 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
463 cd write (iout,'(2i3,3f10.5)')
464 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
470 num_cont(i)=num_conti
475 gvdwc(j,i)=expon*gvdwc(j,i)
476 gvdwx(j,i)=expon*gvdwx(j,i)
480 C******************************************************************************
484 C To save time, the factor of EXPON has been extracted from ALL components
485 C of GVDWC and GRADX. Remember to multiply them by this factor before further
488 C******************************************************************************
491 C-----------------------------------------------------------------------------
492 subroutine eljk(evdw)
494 C This subroutine calculates the interaction energy of nonbonded side chains
495 C assuming the LJK potential of interaction.
497 implicit real*8 (a-h,o-z)
499 include 'sizesclu.dat'
500 c include "DIMENSIONS.COMPAR"
503 include 'COMMON.LOCAL'
504 include 'COMMON.CHAIN'
505 include 'COMMON.DERIV'
506 include 'COMMON.INTERACT'
507 include 'COMMON.IOUNITS'
508 include 'COMMON.NAMES'
513 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
522 C Calculate SC interaction energy.
525 do j=istart(i,iint),iend(i,iint)
530 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
532 e_augm=augm(itypi,itypj)*fac_augm
535 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
536 fac=r_shift_inv**expon
537 e1=fac*fac*aa(itypi,itypj)
538 e2=fac*bb(itypi,itypj)
540 ij=icant(itypi,itypj)
541 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
542 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
543 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
544 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
545 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
546 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
547 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
551 C Calculate the components of the gradient in DC and X
553 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
558 gvdwx(k,i)=gvdwx(k,i)-gg(k)
559 gvdwx(k,j)=gvdwx(k,j)+gg(k)
563 gvdwc(l,k)=gvdwc(l,k)+gg(l)
573 gvdwc(j,i)=expon*gvdwc(j,i)
574 gvdwx(j,i)=expon*gvdwx(j,i)
580 C-----------------------------------------------------------------------------
583 C This subroutine calculates the interaction energy of nonbonded side chains
584 C assuming the Berne-Pechukas potential of interaction.
586 implicit real*8 (a-h,o-z)
588 include 'sizesclu.dat'
589 c include "DIMENSIONS.COMPAR"
592 include 'COMMON.LOCAL'
593 include 'COMMON.CHAIN'
594 include 'COMMON.DERIV'
595 include 'COMMON.NAMES'
596 include 'COMMON.INTERACT'
597 include 'COMMON.IOUNITS'
598 include 'COMMON.CALC'
600 c double precision rrsave(maxdim)
605 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
607 c if (icall.eq.0) then
619 dxi=dc_norm(1,nres+i)
620 dyi=dc_norm(2,nres+i)
621 dzi=dc_norm(3,nres+i)
622 dsci_inv=vbld_inv(i+nres)
624 C Calculate SC interaction energy.
627 do j=istart(i,iint),iend(i,iint)
630 dscj_inv=vbld_inv(j+nres)
631 chi1=chi(itypi,itypj)
632 chi2=chi(itypj,itypi)
639 alf12=0.5D0*(alf1+alf2)
640 C For diagnostics only!!!
653 dxj=dc_norm(1,nres+j)
654 dyj=dc_norm(2,nres+j)
655 dzj=dc_norm(3,nres+j)
656 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
657 cd if (icall.eq.0) then
663 C Calculate the angle-dependent terms of energy & contributions to derivatives.
665 C Calculate whole angle-dependent part of epsilon and contributions
667 fac=(rrij*sigsq)**expon2
668 e1=fac*fac*aa(itypi,itypj)
669 e2=fac*bb(itypi,itypj)
670 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
671 eps2der=evdwij*eps3rt
672 eps3der=evdwij*eps2rt
673 evdwij=evdwij*eps2rt*eps3rt
674 ij=icant(itypi,itypj)
675 aux=eps1*eps2rt**2*eps3rt**2
679 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
680 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
681 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
682 cd & restyp(itypi),i,restyp(itypj),j,
683 cd & epsi,sigm,chi1,chi2,chip1,chip2,
684 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
685 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
688 C Calculate gradient components.
689 e1=e1*eps1*eps2rt**2*eps3rt**2
690 fac=-expon*(e1+evdwij)
693 C Calculate radial part of the gradient
697 C Calculate the angular part of the gradient and sum add the contributions
698 C to the appropriate components of the Cartesian gradient.
707 C-----------------------------------------------------------------------------
710 C This subroutine calculates the interaction energy of nonbonded side chains
711 C assuming the Gay-Berne potential of interaction.
713 implicit real*8 (a-h,o-z)
715 include 'sizesclu.dat'
716 c include "DIMENSIONS.COMPAR"
719 include 'COMMON.LOCAL'
720 include 'COMMON.CHAIN'
721 include 'COMMON.DERIV'
722 include 'COMMON.NAMES'
723 include 'COMMON.INTERACT'
724 include 'COMMON.IOUNITS'
725 include 'COMMON.CALC'
731 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
734 c if (icall.gt.0) lprn=.true.
742 dxi=dc_norm(1,nres+i)
743 dyi=dc_norm(2,nres+i)
744 dzi=dc_norm(3,nres+i)
745 dsci_inv=vbld_inv(i+nres)
747 C Calculate SC interaction energy.
750 do j=istart(i,iint),iend(i,iint)
753 dscj_inv=vbld_inv(j+nres)
754 sig0ij=sigma(itypi,itypj)
755 chi1=chi(itypi,itypj)
756 chi2=chi(itypj,itypi)
763 alf12=0.5D0*(alf1+alf2)
764 C For diagnostics only!!!
777 dxj=dc_norm(1,nres+j)
778 dyj=dc_norm(2,nres+j)
779 dzj=dc_norm(3,nres+j)
780 c write (iout,*) i,j,xj,yj,zj
781 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
783 C Calculate angle-dependent terms of energy and contributions to their
787 sig=sig0ij*dsqrt(sigsq)
788 rij_shift=1.0D0/rij-sig+sig0ij
789 C I hate to put IF's in the loops, but here don't have another choice!!!!
790 if (rij_shift.le.0.0D0) then
795 c---------------------------------------------------------------
796 rij_shift=1.0D0/rij_shift
798 e1=fac*fac*aa(itypi,itypj)
799 e2=fac*bb(itypi,itypj)
800 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
801 eps2der=evdwij*eps3rt
802 eps3der=evdwij*eps2rt
803 evdwij=evdwij*eps2rt*eps3rt
805 ij=icant(itypi,itypj)
806 aux=eps1*eps2rt**2*eps3rt**2
807 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
808 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
809 c & aux*e2/eps(itypi,itypj)
811 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
812 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
813 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
814 & restyp(itypi),i,restyp(itypj),j,
815 & epsi,sigm,chi1,chi2,chip1,chip2,
816 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
817 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
821 C Calculate gradient components.
822 e1=e1*eps1*eps2rt**2*eps3rt**2
823 fac=-expon*(e1+evdwij)*rij_shift
826 C Calculate the radial part of the gradient
830 C Calculate angular part of the gradient.
838 C-----------------------------------------------------------------------------
839 subroutine egbv(evdw)
841 C This subroutine calculates the interaction energy of nonbonded side chains
842 C assuming the Gay-Berne-Vorobjev potential of interaction.
844 implicit real*8 (a-h,o-z)
846 include 'sizesclu.dat'
847 c include "DIMENSIONS.COMPAR"
850 include 'COMMON.LOCAL'
851 include 'COMMON.CHAIN'
852 include 'COMMON.DERIV'
853 include 'COMMON.NAMES'
854 include 'COMMON.INTERACT'
855 include 'COMMON.IOUNITS'
856 include 'COMMON.CALC'
862 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
865 c if (icall.gt.0) lprn=.true.
873 dxi=dc_norm(1,nres+i)
874 dyi=dc_norm(2,nres+i)
875 dzi=dc_norm(3,nres+i)
876 dsci_inv=vbld_inv(i+nres)
878 C Calculate SC interaction energy.
881 do j=istart(i,iint),iend(i,iint)
884 dscj_inv=vbld_inv(j+nres)
885 sig0ij=sigma(itypi,itypj)
887 chi1=chi(itypi,itypj)
888 chi2=chi(itypj,itypi)
895 alf12=0.5D0*(alf1+alf2)
896 C For diagnostics only!!!
909 dxj=dc_norm(1,nres+j)
910 dyj=dc_norm(2,nres+j)
911 dzj=dc_norm(3,nres+j)
912 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
914 C Calculate angle-dependent terms of energy and contributions to their
918 sig=sig0ij*dsqrt(sigsq)
919 rij_shift=1.0D0/rij-sig+r0ij
920 C I hate to put IF's in the loops, but here don't have another choice!!!!
921 if (rij_shift.le.0.0D0) then
926 c---------------------------------------------------------------
927 rij_shift=1.0D0/rij_shift
929 e1=fac*fac*aa(itypi,itypj)
930 e2=fac*bb(itypi,itypj)
931 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
932 eps2der=evdwij*eps3rt
933 eps3der=evdwij*eps2rt
935 e_augm=augm(itypi,itypj)*fac_augm
936 evdwij=evdwij*eps2rt*eps3rt
937 evdw=evdw+evdwij+e_augm
938 ij=icant(itypi,itypj)
939 aux=eps1*eps2rt**2*eps3rt**2
941 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
942 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
943 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
944 c & restyp(itypi),i,restyp(itypj),j,
945 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
946 c & chi1,chi2,chip1,chip2,
947 c & eps1,eps2rt**2,eps3rt**2,
948 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
952 C Calculate gradient components.
953 e1=e1*eps1*eps2rt**2*eps3rt**2
954 fac=-expon*(e1+evdwij)*rij_shift
956 fac=rij*fac-2*expon*rrij*e_augm
957 C Calculate the radial part of the gradient
961 C Calculate angular part of the gradient.
969 C-----------------------------------------------------------------------------
970 subroutine sc_angular
971 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
972 C om12. Called by ebp, egb, and egbv.
974 include 'COMMON.CALC'
978 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
979 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
980 om12=dxi*dxj+dyi*dyj+dzi*dzj
982 C Calculate eps1(om12) and its derivative in om12
983 faceps1=1.0D0-om12*chiom12
984 faceps1_inv=1.0D0/faceps1
985 eps1=dsqrt(faceps1_inv)
986 C Following variable is eps1*deps1/dom12
987 eps1_om12=faceps1_inv*chiom12
988 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
993 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
994 sigsq=1.0D0-facsig*faceps1_inv
995 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
996 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
997 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
998 C Calculate eps2 and its derivatives in om1, om2, and om12.
1001 chipom12=chip12*om12
1002 facp=1.0D0-om12*chipom12
1004 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1005 C Following variable is the square root of eps2
1006 eps2rt=1.0D0-facp1*facp_inv
1007 C Following three variables are the derivatives of the square root of eps
1008 C in om1, om2, and om12.
1009 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1010 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1011 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1012 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1013 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1014 C Calculate whole angle-dependent part of epsilon and contributions
1015 C to its derivatives
1018 C----------------------------------------------------------------------------
1020 implicit real*8 (a-h,o-z)
1021 include 'DIMENSIONS'
1022 include 'sizesclu.dat'
1023 include 'COMMON.CHAIN'
1024 include 'COMMON.DERIV'
1025 include 'COMMON.CALC'
1026 double precision dcosom1(3),dcosom2(3)
1027 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1028 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1029 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1030 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1032 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1033 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1036 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1039 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1040 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1041 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1042 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1043 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1044 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1047 C Calculate the components of the gradient in DC and X
1051 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1056 c------------------------------------------------------------------------------
1057 subroutine vec_and_deriv
1058 implicit real*8 (a-h,o-z)
1059 include 'DIMENSIONS'
1060 include 'sizesclu.dat'
1061 include 'COMMON.IOUNITS'
1062 include 'COMMON.GEO'
1063 include 'COMMON.VAR'
1064 include 'COMMON.LOCAL'
1065 include 'COMMON.CHAIN'
1066 include 'COMMON.VECTORS'
1067 include 'COMMON.DERIV'
1068 include 'COMMON.INTERACT'
1069 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1070 C Compute the local reference systems. For reference system (i), the
1071 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1072 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1074 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1075 if (i.eq.nres-1) then
1076 C Case of the last full residue
1077 C Compute the Z-axis
1078 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1079 costh=dcos(pi-theta(nres))
1080 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1085 C Compute the derivatives of uz
1087 uzder(2,1,1)=-dc_norm(3,i-1)
1088 uzder(3,1,1)= dc_norm(2,i-1)
1089 uzder(1,2,1)= dc_norm(3,i-1)
1091 uzder(3,2,1)=-dc_norm(1,i-1)
1092 uzder(1,3,1)=-dc_norm(2,i-1)
1093 uzder(2,3,1)= dc_norm(1,i-1)
1096 uzder(2,1,2)= dc_norm(3,i)
1097 uzder(3,1,2)=-dc_norm(2,i)
1098 uzder(1,2,2)=-dc_norm(3,i)
1100 uzder(3,2,2)= dc_norm(1,i)
1101 uzder(1,3,2)= dc_norm(2,i)
1102 uzder(2,3,2)=-dc_norm(1,i)
1105 C Compute the Y-axis
1108 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1111 C Compute the derivatives of uy
1114 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1115 & -dc_norm(k,i)*dc_norm(j,i-1)
1116 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1118 uyder(j,j,1)=uyder(j,j,1)-costh
1119 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1124 uygrad(l,k,j,i)=uyder(l,k,j)
1125 uzgrad(l,k,j,i)=uzder(l,k,j)
1129 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1130 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1131 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1132 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1136 C Compute the Z-axis
1137 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1138 costh=dcos(pi-theta(i+2))
1139 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1144 C Compute the derivatives of uz
1146 uzder(2,1,1)=-dc_norm(3,i+1)
1147 uzder(3,1,1)= dc_norm(2,i+1)
1148 uzder(1,2,1)= dc_norm(3,i+1)
1150 uzder(3,2,1)=-dc_norm(1,i+1)
1151 uzder(1,3,1)=-dc_norm(2,i+1)
1152 uzder(2,3,1)= dc_norm(1,i+1)
1155 uzder(2,1,2)= dc_norm(3,i)
1156 uzder(3,1,2)=-dc_norm(2,i)
1157 uzder(1,2,2)=-dc_norm(3,i)
1159 uzder(3,2,2)= dc_norm(1,i)
1160 uzder(1,3,2)= dc_norm(2,i)
1161 uzder(2,3,2)=-dc_norm(1,i)
1164 C Compute the Y-axis
1167 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1170 C Compute the derivatives of uy
1173 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1174 & -dc_norm(k,i)*dc_norm(j,i+1)
1175 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1177 uyder(j,j,1)=uyder(j,j,1)-costh
1178 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1183 uygrad(l,k,j,i)=uyder(l,k,j)
1184 uzgrad(l,k,j,i)=uzder(l,k,j)
1188 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1189 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1190 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1191 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1197 vbld_inv_temp(1)=vbld_inv(i+1)
1198 if (i.lt.nres-1) then
1199 vbld_inv_temp(2)=vbld_inv(i+2)
1201 vbld_inv_temp(2)=vbld_inv(i)
1206 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1207 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1215 C-----------------------------------------------------------------------------
1216 subroutine vec_and_deriv_test
1217 implicit real*8 (a-h,o-z)
1218 include 'DIMENSIONS'
1219 include 'sizesclu.dat'
1220 include 'COMMON.IOUNITS'
1221 include 'COMMON.GEO'
1222 include 'COMMON.VAR'
1223 include 'COMMON.LOCAL'
1224 include 'COMMON.CHAIN'
1225 include 'COMMON.VECTORS'
1226 dimension uyder(3,3,2),uzder(3,3,2)
1227 C Compute the local reference systems. For reference system (i), the
1228 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1229 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1231 if (i.eq.nres-1) then
1232 C Case of the last full residue
1233 C Compute the Z-axis
1234 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1235 costh=dcos(pi-theta(nres))
1236 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1237 c write (iout,*) 'fac',fac,
1238 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1239 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1243 C Compute the derivatives of uz
1245 uzder(2,1,1)=-dc_norm(3,i-1)
1246 uzder(3,1,1)= dc_norm(2,i-1)
1247 uzder(1,2,1)= dc_norm(3,i-1)
1249 uzder(3,2,1)=-dc_norm(1,i-1)
1250 uzder(1,3,1)=-dc_norm(2,i-1)
1251 uzder(2,3,1)= dc_norm(1,i-1)
1254 uzder(2,1,2)= dc_norm(3,i)
1255 uzder(3,1,2)=-dc_norm(2,i)
1256 uzder(1,2,2)=-dc_norm(3,i)
1258 uzder(3,2,2)= dc_norm(1,i)
1259 uzder(1,3,2)= dc_norm(2,i)
1260 uzder(2,3,2)=-dc_norm(1,i)
1262 C Compute the Y-axis
1264 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1267 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1268 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1269 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1271 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1274 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1275 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1278 c write (iout,*) 'facy',facy,
1279 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1280 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1282 uy(k,i)=facy*uy(k,i)
1284 C Compute the derivatives of uy
1287 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1288 & -dc_norm(k,i)*dc_norm(j,i-1)
1289 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1291 c uyder(j,j,1)=uyder(j,j,1)-costh
1292 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1293 uyder(j,j,1)=uyder(j,j,1)
1294 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1295 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1301 uygrad(l,k,j,i)=uyder(l,k,j)
1302 uzgrad(l,k,j,i)=uzder(l,k,j)
1306 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1307 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1308 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1309 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1312 C Compute the Z-axis
1313 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1314 costh=dcos(pi-theta(i+2))
1315 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1316 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1320 C Compute the derivatives of uz
1322 uzder(2,1,1)=-dc_norm(3,i+1)
1323 uzder(3,1,1)= dc_norm(2,i+1)
1324 uzder(1,2,1)= dc_norm(3,i+1)
1326 uzder(3,2,1)=-dc_norm(1,i+1)
1327 uzder(1,3,1)=-dc_norm(2,i+1)
1328 uzder(2,3,1)= dc_norm(1,i+1)
1331 uzder(2,1,2)= dc_norm(3,i)
1332 uzder(3,1,2)=-dc_norm(2,i)
1333 uzder(1,2,2)=-dc_norm(3,i)
1335 uzder(3,2,2)= dc_norm(1,i)
1336 uzder(1,3,2)= dc_norm(2,i)
1337 uzder(2,3,2)=-dc_norm(1,i)
1339 C Compute the Y-axis
1341 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1342 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1343 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1345 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1348 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1349 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1352 c write (iout,*) 'facy',facy,
1353 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1354 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1356 uy(k,i)=facy*uy(k,i)
1358 C Compute the derivatives of uy
1361 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1362 & -dc_norm(k,i)*dc_norm(j,i+1)
1363 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1365 c uyder(j,j,1)=uyder(j,j,1)-costh
1366 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1367 uyder(j,j,1)=uyder(j,j,1)
1368 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1369 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1375 uygrad(l,k,j,i)=uyder(l,k,j)
1376 uzgrad(l,k,j,i)=uzder(l,k,j)
1380 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1381 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1382 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1383 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1390 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1391 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1398 C-----------------------------------------------------------------------------
1399 subroutine check_vecgrad
1400 implicit real*8 (a-h,o-z)
1401 include 'DIMENSIONS'
1402 include 'sizesclu.dat'
1403 include 'COMMON.IOUNITS'
1404 include 'COMMON.GEO'
1405 include 'COMMON.VAR'
1406 include 'COMMON.LOCAL'
1407 include 'COMMON.CHAIN'
1408 include 'COMMON.VECTORS'
1409 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1410 dimension uyt(3,maxres),uzt(3,maxres)
1411 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1412 double precision delta /1.0d-7/
1415 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1416 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1417 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1418 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1419 cd & (dc_norm(if90,i),if90=1,3)
1420 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1421 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1422 cd write(iout,'(a)')
1428 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1429 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1442 cd write (iout,*) 'i=',i
1444 erij(k)=dc_norm(k,i)
1448 dc_norm(k,i)=erij(k)
1450 dc_norm(j,i)=dc_norm(j,i)+delta
1451 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1453 c dc_norm(k,i)=dc_norm(k,i)/fac
1455 c write (iout,*) (dc_norm(k,i),k=1,3)
1456 c write (iout,*) (erij(k),k=1,3)
1459 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1460 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1461 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1462 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1464 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1465 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1466 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1469 dc_norm(k,i)=erij(k)
1472 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1473 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1474 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1475 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1476 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1477 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1478 cd write (iout,'(a)')
1483 C--------------------------------------------------------------------------
1484 subroutine set_matrices
1485 implicit real*8 (a-h,o-z)
1486 include 'DIMENSIONS'
1487 include 'sizesclu.dat'
1488 include 'COMMON.IOUNITS'
1489 include 'COMMON.GEO'
1490 include 'COMMON.VAR'
1491 include 'COMMON.LOCAL'
1492 include 'COMMON.CHAIN'
1493 include 'COMMON.DERIV'
1494 include 'COMMON.INTERACT'
1495 include 'COMMON.CONTACTS'
1496 include 'COMMON.TORSION'
1497 include 'COMMON.VECTORS'
1498 include 'COMMON.FFIELD'
1499 double precision auxvec(2),auxmat(2,2)
1501 C Compute the virtual-bond-torsional-angle dependent quantities needed
1502 C to calculate the el-loc multibody terms of various order.
1505 if (i .lt. nres+1) then
1542 if (i .gt. 3 .and. i .lt. nres+1) then
1543 obrot_der(1,i-2)=-sin1
1544 obrot_der(2,i-2)= cos1
1545 Ugder(1,1,i-2)= sin1
1546 Ugder(1,2,i-2)=-cos1
1547 Ugder(2,1,i-2)=-cos1
1548 Ugder(2,2,i-2)=-sin1
1551 obrot2_der(1,i-2)=-dwasin2
1552 obrot2_der(2,i-2)= dwacos2
1553 Ug2der(1,1,i-2)= dwasin2
1554 Ug2der(1,2,i-2)=-dwacos2
1555 Ug2der(2,1,i-2)=-dwacos2
1556 Ug2der(2,2,i-2)=-dwasin2
1558 obrot_der(1,i-2)=0.0d0
1559 obrot_der(2,i-2)=0.0d0
1560 Ugder(1,1,i-2)=0.0d0
1561 Ugder(1,2,i-2)=0.0d0
1562 Ugder(2,1,i-2)=0.0d0
1563 Ugder(2,2,i-2)=0.0d0
1564 obrot2_der(1,i-2)=0.0d0
1565 obrot2_der(2,i-2)=0.0d0
1566 Ug2der(1,1,i-2)=0.0d0
1567 Ug2der(1,2,i-2)=0.0d0
1568 Ug2der(2,1,i-2)=0.0d0
1569 Ug2der(2,2,i-2)=0.0d0
1571 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1572 iti = itortyp(itype(i-2))
1576 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1577 iti1 = itortyp(itype(i-1))
1581 cd write (iout,*) '*******i',i,' iti1',iti
1582 cd write (iout,*) 'b1',b1(:,iti)
1583 cd write (iout,*) 'b2',b2(:,iti)
1584 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1585 if (i .gt. iatel_s+2) then
1586 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1587 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1588 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1589 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1590 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1591 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1592 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1602 DtUg2(l,k,i-2)=0.0d0
1606 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1607 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1608 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1609 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1610 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1611 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1612 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1614 muder(k,i-2)=Ub2der(k,i-2)
1616 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1617 iti1 = itortyp(itype(i-1))
1622 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1624 C Vectors and matrices dependent on a single virtual-bond dihedral.
1625 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1626 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1627 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1628 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1629 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1630 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1631 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1632 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1633 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1634 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1635 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1637 C Matrices dependent on two consecutive virtual-bond dihedrals.
1638 C The order of matrices is from left to right.
1640 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1641 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1642 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1643 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1644 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1645 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1646 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1647 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1650 cd iti = itortyp(itype(i))
1653 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1654 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1659 C--------------------------------------------------------------------------
1660 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1662 C This subroutine calculates the average interaction energy and its gradient
1663 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1664 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1665 C The potential depends both on the distance of peptide-group centers and on
1666 C the orientation of the CA-CA virtual bonds.
1668 implicit real*8 (a-h,o-z)
1669 include 'DIMENSIONS'
1670 include 'sizesclu.dat'
1671 include 'COMMON.CONTROL'
1672 include 'COMMON.IOUNITS'
1673 include 'COMMON.GEO'
1674 include 'COMMON.VAR'
1675 include 'COMMON.LOCAL'
1676 include 'COMMON.CHAIN'
1677 include 'COMMON.DERIV'
1678 include 'COMMON.INTERACT'
1679 include 'COMMON.CONTACTS'
1680 include 'COMMON.TORSION'
1681 include 'COMMON.VECTORS'
1682 include 'COMMON.FFIELD'
1683 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1684 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1685 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1686 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1687 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1688 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1689 double precision scal_el /0.5d0/
1691 C 13-go grudnia roku pamietnego...
1692 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1693 & 0.0d0,1.0d0,0.0d0,
1694 & 0.0d0,0.0d0,1.0d0/
1695 cd write(iout,*) 'In EELEC'
1697 cd write(iout,*) 'Type',i
1698 cd write(iout,*) 'B1',B1(:,i)
1699 cd write(iout,*) 'B2',B2(:,i)
1700 cd write(iout,*) 'CC',CC(:,:,i)
1701 cd write(iout,*) 'DD',DD(:,:,i)
1702 cd write(iout,*) 'EE',EE(:,:,i)
1704 cd call check_vecgrad
1706 if (icheckgrad.eq.1) then
1708 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1710 dc_norm(k,i)=dc(k,i)*fac
1712 c write (iout,*) 'i',i,' fac',fac
1715 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1716 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1717 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1718 cd if (wel_loc.gt.0.0d0) then
1719 if (icheckgrad.eq.1) then
1720 call vec_and_deriv_test
1727 cd write (iout,*) 'i=',i
1729 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1732 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1733 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1746 cd print '(a)','Enter EELEC'
1747 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1749 gel_loc_loc(i)=0.0d0
1752 do i=iatel_s,iatel_e
1753 if (itel(i).eq.0) goto 1215
1757 dx_normi=dc_norm(1,i)
1758 dy_normi=dc_norm(2,i)
1759 dz_normi=dc_norm(3,i)
1760 xmedi=c(1,i)+0.5d0*dxi
1761 ymedi=c(2,i)+0.5d0*dyi
1762 zmedi=c(3,i)+0.5d0*dzi
1764 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1765 do j=ielstart(i),ielend(i)
1766 if (itel(j).eq.0) goto 1216
1770 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1771 aaa=app(iteli,itelj)
1772 bbb=bpp(iteli,itelj)
1773 C Diagnostics only!!!
1779 ael6i=ael6(iteli,itelj)
1780 ael3i=ael3(iteli,itelj)
1784 dx_normj=dc_norm(1,j)
1785 dy_normj=dc_norm(2,j)
1786 dz_normj=dc_norm(3,j)
1787 xj=c(1,j)+0.5D0*dxj-xmedi
1788 yj=c(2,j)+0.5D0*dyj-ymedi
1789 zj=c(3,j)+0.5D0*dzj-zmedi
1790 rij=xj*xj+yj*yj+zj*zj
1796 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1797 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1798 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1799 fac=cosa-3.0D0*cosb*cosg
1801 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1802 if (j.eq.i+2) ev1=scal_el*ev1
1807 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1810 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1811 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1812 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1815 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1816 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1817 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1818 cd & xmedi,ymedi,zmedi,xj,yj,zj
1820 C Calculate contributions to the Cartesian gradient.
1823 facvdw=-6*rrmij*(ev1+evdwij)
1824 facel=-3*rrmij*(el1+eesij)
1831 * Radial derivatives. First process both termini of the fragment (i,j)
1838 gelc(k,i)=gelc(k,i)+ghalf
1839 gelc(k,j)=gelc(k,j)+ghalf
1842 * Loop over residues i+1 thru j-1.
1846 gelc(l,k)=gelc(l,k)+ggg(l)
1854 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1855 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1858 * Loop over residues i+1 thru j-1.
1862 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1869 fac=-3*rrmij*(facvdw+facvdw+facel)
1875 * Radial derivatives. First process both termini of the fragment (i,j)
1882 gelc(k,i)=gelc(k,i)+ghalf
1883 gelc(k,j)=gelc(k,j)+ghalf
1886 * Loop over residues i+1 thru j-1.
1890 gelc(l,k)=gelc(l,k)+ggg(l)
1897 ecosa=2.0D0*fac3*fac1+fac4
1900 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1901 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1903 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1904 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1906 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1907 cd & (dcosg(k),k=1,3)
1909 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1913 gelc(k,i)=gelc(k,i)+ghalf
1914 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1915 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1916 gelc(k,j)=gelc(k,j)+ghalf
1917 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1918 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1922 gelc(l,k)=gelc(l,k)+ggg(l)
1927 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1928 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
1929 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
1931 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
1932 C energy of a peptide unit is assumed in the form of a second-order
1933 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
1934 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
1935 C are computed for EVERY pair of non-contiguous peptide groups.
1937 if (j.lt.nres-1) then
1948 muij(kkk)=mu(k,i)*mu(l,j)
1951 cd write (iout,*) 'EELEC: i',i,' j',j
1952 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
1953 cd write(iout,*) 'muij',muij
1954 ury=scalar(uy(1,i),erij)
1955 urz=scalar(uz(1,i),erij)
1956 vry=scalar(uy(1,j),erij)
1957 vrz=scalar(uz(1,j),erij)
1958 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
1959 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
1960 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
1961 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
1962 C For diagnostics only
1967 fac=dsqrt(-ael6i)*r3ij
1968 cd write (2,*) 'fac=',fac
1969 C For diagnostics only
1975 cd write (iout,'(4i5,4f10.5)')
1976 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
1977 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
1978 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
1979 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
1980 cd write (iout,'(4f10.5)')
1981 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
1982 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
1983 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
1984 cd write (iout,'(2i3,9f10.5/)') i,j,
1985 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
1987 C Derivatives of the elements of A in virtual-bond vectors
1988 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
1995 uryg(k,1)=scalar(erder(1,k),uy(1,i))
1996 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
1997 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
1998 urzg(k,1)=scalar(erder(1,k),uz(1,i))
1999 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2000 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2001 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2002 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2003 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2004 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2005 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2006 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2016 C Compute radial contributions to the gradient
2038 C Add the contributions coming from er
2041 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2042 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2043 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2044 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2047 C Derivatives in DC(i)
2048 ghalf1=0.5d0*agg(k,1)
2049 ghalf2=0.5d0*agg(k,2)
2050 ghalf3=0.5d0*agg(k,3)
2051 ghalf4=0.5d0*agg(k,4)
2052 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2053 & -3.0d0*uryg(k,2)*vry)+ghalf1
2054 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2055 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2056 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2057 & -3.0d0*urzg(k,2)*vry)+ghalf3
2058 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2059 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2060 C Derivatives in DC(i+1)
2061 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2062 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2063 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2064 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2065 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2066 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2067 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2068 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2069 C Derivatives in DC(j)
2070 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2071 & -3.0d0*vryg(k,2)*ury)+ghalf1
2072 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2073 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2074 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2075 & -3.0d0*vryg(k,2)*urz)+ghalf3
2076 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2077 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2078 C Derivatives in DC(j+1) or DC(nres-1)
2079 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2080 & -3.0d0*vryg(k,3)*ury)
2081 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2082 & -3.0d0*vrzg(k,3)*ury)
2083 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2084 & -3.0d0*vryg(k,3)*urz)
2085 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2086 & -3.0d0*vrzg(k,3)*urz)
2091 C Derivatives in DC(i+1)
2092 cd aggi1(k,1)=agg(k,1)
2093 cd aggi1(k,2)=agg(k,2)
2094 cd aggi1(k,3)=agg(k,3)
2095 cd aggi1(k,4)=agg(k,4)
2096 C Derivatives in DC(j)
2101 C Derivatives in DC(j+1)
2106 if (j.eq.nres-1 .and. i.lt.j-2) then
2108 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2109 cd aggj1(k,l)=agg(k,l)
2115 C Check the loc-el terms by numerical integration
2125 aggi(k,l)=-aggi(k,l)
2126 aggi1(k,l)=-aggi1(k,l)
2127 aggj(k,l)=-aggj(k,l)
2128 aggj1(k,l)=-aggj1(k,l)
2131 if (j.lt.nres-1) then
2137 aggi(k,l)=-aggi(k,l)
2138 aggi1(k,l)=-aggi1(k,l)
2139 aggj(k,l)=-aggj(k,l)
2140 aggj1(k,l)=-aggj1(k,l)
2151 aggi(k,l)=-aggi(k,l)
2152 aggi1(k,l)=-aggi1(k,l)
2153 aggj(k,l)=-aggj(k,l)
2154 aggj1(k,l)=-aggj1(k,l)
2160 IF (wel_loc.gt.0.0d0) THEN
2161 C Contribution to the local-electrostatic energy coming from the i-j pair
2162 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2164 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2165 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2166 eel_loc=eel_loc+eel_loc_ij
2167 C Partial derivatives in virtual-bond dihedral angles gamma
2170 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2171 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2172 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2173 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2174 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2175 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2176 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2177 cd write(iout,*) 'agg ',agg
2178 cd write(iout,*) 'aggi ',aggi
2179 cd write(iout,*) 'aggi1',aggi1
2180 cd write(iout,*) 'aggj ',aggj
2181 cd write(iout,*) 'aggj1',aggj1
2183 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2185 ggg(l)=agg(l,1)*muij(1)+
2186 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2190 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2193 C Remaining derivatives of eello
2195 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2196 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2197 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2198 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2199 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2200 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2201 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2202 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2206 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2207 C Contributions from turns
2212 call eturn34(i,j,eello_turn3,eello_turn4)
2214 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2215 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2217 C Calculate the contact function. The ith column of the array JCONT will
2218 C contain the numbers of atoms that make contacts with the atom I (of numbers
2219 C greater than I). The arrays FACONT and GACONT will contain the values of
2220 C the contact function and its derivative.
2221 c r0ij=1.02D0*rpp(iteli,itelj)
2222 c r0ij=1.11D0*rpp(iteli,itelj)
2223 r0ij=2.20D0*rpp(iteli,itelj)
2224 c r0ij=1.55D0*rpp(iteli,itelj)
2225 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2226 if (fcont.gt.0.0D0) then
2227 num_conti=num_conti+1
2228 if (num_conti.gt.maxconts) then
2229 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2230 & ' will skip next contacts for this conf.'
2232 jcont_hb(num_conti,i)=j
2233 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2234 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2235 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2237 d_cont(num_conti,i)=rij
2238 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2239 C --- Electrostatic-interaction matrix ---
2240 a_chuj(1,1,num_conti,i)=a22
2241 a_chuj(1,2,num_conti,i)=a23
2242 a_chuj(2,1,num_conti,i)=a32
2243 a_chuj(2,2,num_conti,i)=a33
2244 C --- Gradient of rij
2246 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2249 c a_chuj(1,1,num_conti,i)=-0.61d0
2250 c a_chuj(1,2,num_conti,i)= 0.4d0
2251 c a_chuj(2,1,num_conti,i)= 0.65d0
2252 c a_chuj(2,2,num_conti,i)= 0.50d0
2253 c else if (i.eq.2) then
2254 c a_chuj(1,1,num_conti,i)= 0.0d0
2255 c a_chuj(1,2,num_conti,i)= 0.0d0
2256 c a_chuj(2,1,num_conti,i)= 0.0d0
2257 c a_chuj(2,2,num_conti,i)= 0.0d0
2259 C --- and its gradients
2260 cd write (iout,*) 'i',i,' j',j
2262 cd write (iout,*) 'iii 1 kkk',kkk
2263 cd write (iout,*) agg(kkk,:)
2266 cd write (iout,*) 'iii 2 kkk',kkk
2267 cd write (iout,*) aggi(kkk,:)
2270 cd write (iout,*) 'iii 3 kkk',kkk
2271 cd write (iout,*) aggi1(kkk,:)
2274 cd write (iout,*) 'iii 4 kkk',kkk
2275 cd write (iout,*) aggj(kkk,:)
2278 cd write (iout,*) 'iii 5 kkk',kkk
2279 cd write (iout,*) aggj1(kkk,:)
2286 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2287 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2288 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2289 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2290 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2292 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2298 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2299 C Calculate contact energies
2301 wij=cosa-3.0D0*cosb*cosg
2304 c fac3=dsqrt(-ael6i)/r0ij**3
2305 fac3=dsqrt(-ael6i)*r3ij
2306 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2307 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2309 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2310 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2311 C Diagnostics. Comment out or remove after debugging!
2312 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2313 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2314 c ees0m(num_conti,i)=0.0D0
2316 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2317 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2318 facont_hb(num_conti,i)=fcont
2320 C Angular derivatives of the contact function
2321 ees0pij1=fac3/ees0pij
2322 ees0mij1=fac3/ees0mij
2323 fac3p=-3.0D0*fac3*rrmij
2324 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2325 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2327 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2328 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2329 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2330 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2331 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2332 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2333 ecosap=ecosa1+ecosa2
2334 ecosbp=ecosb1+ecosb2
2335 ecosgp=ecosg1+ecosg2
2336 ecosam=ecosa1-ecosa2
2337 ecosbm=ecosb1-ecosb2
2338 ecosgm=ecosg1-ecosg2
2347 fprimcont=fprimcont/rij
2348 cd facont_hb(num_conti,i)=1.0D0
2349 C Following line is for diagnostics.
2352 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2353 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2356 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2357 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2359 gggp(1)=gggp(1)+ees0pijp*xj
2360 gggp(2)=gggp(2)+ees0pijp*yj
2361 gggp(3)=gggp(3)+ees0pijp*zj
2362 gggm(1)=gggm(1)+ees0mijp*xj
2363 gggm(2)=gggm(2)+ees0mijp*yj
2364 gggm(3)=gggm(3)+ees0mijp*zj
2365 C Derivatives due to the contact function
2366 gacont_hbr(1,num_conti,i)=fprimcont*xj
2367 gacont_hbr(2,num_conti,i)=fprimcont*yj
2368 gacont_hbr(3,num_conti,i)=fprimcont*zj
2370 ghalfp=0.5D0*gggp(k)
2371 ghalfm=0.5D0*gggm(k)
2372 gacontp_hb1(k,num_conti,i)=ghalfp
2373 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2374 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2375 gacontp_hb2(k,num_conti,i)=ghalfp
2376 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2377 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2378 gacontp_hb3(k,num_conti,i)=gggp(k)
2379 gacontm_hb1(k,num_conti,i)=ghalfm
2380 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2381 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2382 gacontm_hb2(k,num_conti,i)=ghalfm
2383 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2384 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2385 gacontm_hb3(k,num_conti,i)=gggm(k)
2388 C Diagnostics. Comment out or remove after debugging!
2390 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2391 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2392 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2393 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2394 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2395 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2398 endif ! num_conti.le.maxconts
2403 num_cont_hb(i)=num_conti
2407 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2408 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2410 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2411 ccc eel_loc=eel_loc+eello_turn3
2414 C-----------------------------------------------------------------------------
2415 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2416 C Third- and fourth-order contributions from turns
2417 implicit real*8 (a-h,o-z)
2418 include 'DIMENSIONS'
2419 include 'sizesclu.dat'
2420 include 'COMMON.IOUNITS'
2421 include 'COMMON.GEO'
2422 include 'COMMON.VAR'
2423 include 'COMMON.LOCAL'
2424 include 'COMMON.CHAIN'
2425 include 'COMMON.DERIV'
2426 include 'COMMON.INTERACT'
2427 include 'COMMON.CONTACTS'
2428 include 'COMMON.TORSION'
2429 include 'COMMON.VECTORS'
2430 include 'COMMON.FFIELD'
2432 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2433 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2434 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2435 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2436 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2437 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2439 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2441 C Third-order contributions
2448 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2449 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2450 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2451 call transpose2(auxmat(1,1),auxmat1(1,1))
2452 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2453 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2454 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2455 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2456 cd & ' eello_turn3_num',4*eello_turn3_num
2458 C Derivatives in gamma(i)
2459 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2460 call transpose2(auxmat2(1,1),pizda(1,1))
2461 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2462 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2463 C Derivatives in gamma(i+1)
2464 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2465 call transpose2(auxmat2(1,1),pizda(1,1))
2466 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2467 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2468 & +0.5d0*(pizda(1,1)+pizda(2,2))
2469 C Cartesian derivatives
2471 a_temp(1,1)=aggi(l,1)
2472 a_temp(1,2)=aggi(l,2)
2473 a_temp(2,1)=aggi(l,3)
2474 a_temp(2,2)=aggi(l,4)
2475 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2476 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2477 & +0.5d0*(pizda(1,1)+pizda(2,2))
2478 a_temp(1,1)=aggi1(l,1)
2479 a_temp(1,2)=aggi1(l,2)
2480 a_temp(2,1)=aggi1(l,3)
2481 a_temp(2,2)=aggi1(l,4)
2482 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2483 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2484 & +0.5d0*(pizda(1,1)+pizda(2,2))
2485 a_temp(1,1)=aggj(l,1)
2486 a_temp(1,2)=aggj(l,2)
2487 a_temp(2,1)=aggj(l,3)
2488 a_temp(2,2)=aggj(l,4)
2489 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2490 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2491 & +0.5d0*(pizda(1,1)+pizda(2,2))
2492 a_temp(1,1)=aggj1(l,1)
2493 a_temp(1,2)=aggj1(l,2)
2494 a_temp(2,1)=aggj1(l,3)
2495 a_temp(2,2)=aggj1(l,4)
2496 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2497 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2498 & +0.5d0*(pizda(1,1)+pizda(2,2))
2501 else if (j.eq.i+3) then
2502 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2504 C Fourth-order contributions
2512 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2513 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2514 iti1=itortyp(itype(i+1))
2515 iti2=itortyp(itype(i+2))
2516 iti3=itortyp(itype(i+3))
2517 call transpose2(EUg(1,1,i+1),e1t(1,1))
2518 call transpose2(Eug(1,1,i+2),e2t(1,1))
2519 call transpose2(Eug(1,1,i+3),e3t(1,1))
2520 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2521 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2522 s1=scalar2(b1(1,iti2),auxvec(1))
2523 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2524 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2525 s2=scalar2(b1(1,iti1),auxvec(1))
2526 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2527 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2528 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2529 eello_turn4=eello_turn4-(s1+s2+s3)
2530 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2531 cd & ' eello_turn4_num',8*eello_turn4_num
2532 C Derivatives in gamma(i)
2534 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2535 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2536 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2537 s1=scalar2(b1(1,iti2),auxvec(1))
2538 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2539 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2540 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2541 C Derivatives in gamma(i+1)
2542 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2543 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2544 s2=scalar2(b1(1,iti1),auxvec(1))
2545 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2546 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2547 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2548 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2549 C Derivatives in gamma(i+2)
2550 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2551 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2552 s1=scalar2(b1(1,iti2),auxvec(1))
2553 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2554 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2555 s2=scalar2(b1(1,iti1),auxvec(1))
2556 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2557 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2558 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2559 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2560 C Cartesian derivatives
2561 C Derivatives of this turn contributions in DC(i+2)
2562 if (j.lt.nres-1) then
2564 a_temp(1,1)=agg(l,1)
2565 a_temp(1,2)=agg(l,2)
2566 a_temp(2,1)=agg(l,3)
2567 a_temp(2,2)=agg(l,4)
2568 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2569 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2570 s1=scalar2(b1(1,iti2),auxvec(1))
2571 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2572 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2573 s2=scalar2(b1(1,iti1),auxvec(1))
2574 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2575 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2576 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2578 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2581 C Remaining derivatives of this turn contribution
2583 a_temp(1,1)=aggi(l,1)
2584 a_temp(1,2)=aggi(l,2)
2585 a_temp(2,1)=aggi(l,3)
2586 a_temp(2,2)=aggi(l,4)
2587 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2588 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2589 s1=scalar2(b1(1,iti2),auxvec(1))
2590 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2591 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2592 s2=scalar2(b1(1,iti1),auxvec(1))
2593 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2594 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2595 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2596 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2597 a_temp(1,1)=aggi1(l,1)
2598 a_temp(1,2)=aggi1(l,2)
2599 a_temp(2,1)=aggi1(l,3)
2600 a_temp(2,2)=aggi1(l,4)
2601 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2602 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2603 s1=scalar2(b1(1,iti2),auxvec(1))
2604 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2605 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2606 s2=scalar2(b1(1,iti1),auxvec(1))
2607 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2608 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2609 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2610 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2611 a_temp(1,1)=aggj(l,1)
2612 a_temp(1,2)=aggj(l,2)
2613 a_temp(2,1)=aggj(l,3)
2614 a_temp(2,2)=aggj(l,4)
2615 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2616 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2617 s1=scalar2(b1(1,iti2),auxvec(1))
2618 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2619 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2620 s2=scalar2(b1(1,iti1),auxvec(1))
2621 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2622 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2623 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2624 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2625 a_temp(1,1)=aggj1(l,1)
2626 a_temp(1,2)=aggj1(l,2)
2627 a_temp(2,1)=aggj1(l,3)
2628 a_temp(2,2)=aggj1(l,4)
2629 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2630 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2631 s1=scalar2(b1(1,iti2),auxvec(1))
2632 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2633 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2634 s2=scalar2(b1(1,iti1),auxvec(1))
2635 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2636 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2637 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2638 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2644 C-----------------------------------------------------------------------------
2645 subroutine vecpr(u,v,w)
2646 implicit real*8(a-h,o-z)
2647 dimension u(3),v(3),w(3)
2648 w(1)=u(2)*v(3)-u(3)*v(2)
2649 w(2)=-u(1)*v(3)+u(3)*v(1)
2650 w(3)=u(1)*v(2)-u(2)*v(1)
2653 C-----------------------------------------------------------------------------
2654 subroutine unormderiv(u,ugrad,unorm,ungrad)
2655 C This subroutine computes the derivatives of a normalized vector u, given
2656 C the derivatives computed without normalization conditions, ugrad. Returns
2659 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2660 double precision vec(3)
2661 double precision scalar
2663 c write (2,*) 'ugrad',ugrad
2666 vec(i)=scalar(ugrad(1,i),u(1))
2668 c write (2,*) 'vec',vec
2671 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2674 c write (2,*) 'ungrad',ungrad
2677 C-----------------------------------------------------------------------------
2678 subroutine escp(evdw2,evdw2_14)
2680 C This subroutine calculates the excluded-volume interaction energy between
2681 C peptide-group centers and side chains and its gradient in virtual-bond and
2682 C side-chain vectors.
2684 implicit real*8 (a-h,o-z)
2685 include 'DIMENSIONS'
2686 include 'sizesclu.dat'
2687 include 'COMMON.GEO'
2688 include 'COMMON.VAR'
2689 include 'COMMON.LOCAL'
2690 include 'COMMON.CHAIN'
2691 include 'COMMON.DERIV'
2692 include 'COMMON.INTERACT'
2693 include 'COMMON.FFIELD'
2694 include 'COMMON.IOUNITS'
2698 cd print '(a)','Enter ESCP'
2699 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2700 c & ' scal14',scal14
2701 do i=iatscp_s,iatscp_e
2703 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2704 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2705 if (iteli.eq.0) goto 1225
2706 xi=0.5D0*(c(1,i)+c(1,i+1))
2707 yi=0.5D0*(c(2,i)+c(2,i+1))
2708 zi=0.5D0*(c(3,i)+c(3,i+1))
2710 do iint=1,nscp_gr(i)
2712 do j=iscpstart(i,iint),iscpend(i,iint)
2714 C Uncomment following three lines for SC-p interactions
2718 C Uncomment following three lines for Ca-p interactions
2722 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2724 e1=fac*fac*aad(itypj,iteli)
2725 e2=fac*bad(itypj,iteli)
2726 if (iabs(j-i) .le. 2) then
2729 evdw2_14=evdw2_14+e1+e2
2732 c write (iout,*) i,j,evdwij
2736 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2738 fac=-(evdwij+e1)*rrij
2743 cd write (iout,*) 'j<i'
2744 C Uncomment following three lines for SC-p interactions
2746 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2749 cd write (iout,*) 'j>i'
2752 C Uncomment following line for SC-p interactions
2753 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2757 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2761 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2762 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2765 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2775 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2776 gradx_scp(j,i)=expon*gradx_scp(j,i)
2779 C******************************************************************************
2783 C To save time the factor EXPON has been extracted from ALL components
2784 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2787 C******************************************************************************
2790 C--------------------------------------------------------------------------
2791 subroutine edis(ehpb)
2793 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2795 implicit real*8 (a-h,o-z)
2796 include 'DIMENSIONS'
2797 include 'COMMON.SBRIDGE'
2798 include 'COMMON.CHAIN'
2799 include 'COMMON.DERIV'
2800 include 'COMMON.VAR'
2801 include 'COMMON.INTERACT'
2802 include 'COMMON.IOUNITS'
2805 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2806 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2807 if (link_end.eq.0) return
2808 do i=link_start,link_end
2809 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2810 C CA-CA distance used in regularization of structure.
2813 C iii and jjj point to the residues for which the distance is assigned.
2814 if (ii.gt.nres) then
2821 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2822 c & dhpb(i),dhpb1(i),forcon(i)
2823 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2824 C distance and angle dependent SS bond potential.
2825 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2826 call ssbond_ene(iii,jjj,eij)
2828 cd write (iout,*) "eij",eij
2829 else if (ii.gt.nres .and. jj.gt.nres) then
2830 c Restraints from contact prediction
2832 if (dhpb1(i).gt.0.0d0) then
2833 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2834 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2835 c write (iout,*) "beta nmr",
2836 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2840 C Get the force constant corresponding to this distance.
2842 C Calculate the contribution to energy.
2843 ehpb=ehpb+waga*rdis*rdis
2844 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2846 C Evaluate gradient.
2851 ggg(j)=fac*(c(j,jj)-c(j,ii))
2854 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2855 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2858 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2859 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2862 C Calculate the distance between the two points and its difference from the
2865 if (dhpb1(i).gt.0.0d0) then
2866 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2867 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2868 c write (iout,*) "alph nmr",
2869 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2872 C Get the force constant corresponding to this distance.
2874 C Calculate the contribution to energy.
2875 ehpb=ehpb+waga*rdis*rdis
2876 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2878 C Evaluate gradient.
2882 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2883 cd & ' waga=',waga,' fac=',fac
2885 ggg(j)=fac*(c(j,jj)-c(j,ii))
2887 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2888 C If this is a SC-SC distance, we need to calculate the contributions to the
2889 C Cartesian gradient in the SC vectors (ghpbx).
2892 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2893 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2897 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2898 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2905 C--------------------------------------------------------------------------
2906 subroutine ssbond_ene(i,j,eij)
2908 C Calculate the distance and angle dependent SS-bond potential energy
2909 C using a free-energy function derived based on RHF/6-31G** ab initio
2910 C calculations of diethyl disulfide.
2912 C A. Liwo and U. Kozlowska, 11/24/03
2914 implicit real*8 (a-h,o-z)
2915 include 'DIMENSIONS'
2916 include 'sizesclu.dat'
2917 include 'COMMON.SBRIDGE'
2918 include 'COMMON.CHAIN'
2919 include 'COMMON.DERIV'
2920 include 'COMMON.LOCAL'
2921 include 'COMMON.INTERACT'
2922 include 'COMMON.VAR'
2923 include 'COMMON.IOUNITS'
2924 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2929 dxi=dc_norm(1,nres+i)
2930 dyi=dc_norm(2,nres+i)
2931 dzi=dc_norm(3,nres+i)
2932 dsci_inv=dsc_inv(itypi)
2934 dscj_inv=dsc_inv(itypj)
2938 dxj=dc_norm(1,nres+j)
2939 dyj=dc_norm(2,nres+j)
2940 dzj=dc_norm(3,nres+j)
2941 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2946 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2947 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2948 om12=dxi*dxj+dyi*dyj+dzi*dzj
2950 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2951 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2957 deltat12=om2-om1+2.0d0
2959 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2960 & +akct*deltad*deltat12
2961 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2962 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2963 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2964 c & " deltat12",deltat12," eij",eij
2965 ed=2*akcm*deltad+akct*deltat12
2967 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
2968 eom1=-2*akth*deltat1-pom1-om2*pom2
2969 eom2= 2*akth*deltat2+pom1-om1*pom2
2972 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2975 ghpbx(k,i)=ghpbx(k,i)-gg(k)
2976 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
2977 ghpbx(k,j)=ghpbx(k,j)+gg(k)
2978 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
2981 C Calculate the components of the gradient in DC and X
2985 ghpbc(l,k)=ghpbc(l,k)+gg(l)
2990 C--------------------------------------------------------------------------
2991 subroutine ebond(estr)
2993 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
2995 implicit real*8 (a-h,o-z)
2996 include 'DIMENSIONS'
2997 include 'COMMON.LOCAL'
2998 include 'COMMON.GEO'
2999 include 'COMMON.INTERACT'
3000 include 'COMMON.DERIV'
3001 include 'COMMON.VAR'
3002 include 'COMMON.CHAIN'
3003 include 'COMMON.IOUNITS'
3004 include 'COMMON.NAMES'
3005 include 'COMMON.FFIELD'
3006 include 'COMMON.CONTROL'
3007 double precision u(3),ud(3)
3010 diff = vbld(i)-vbldp0
3011 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3014 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3019 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3026 diff=vbld(i+nres)-vbldsc0(1,iti)
3027 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3028 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3029 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3031 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3035 diff=vbld(i+nres)-vbldsc0(j,iti)
3036 ud(j)=aksc(j,iti)*diff
3037 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3051 uprod2=uprod2*u(k)*u(k)
3055 usumsqder=usumsqder+ud(j)*uprod2
3057 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3058 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3059 estr=estr+uprod/usum
3061 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3069 C--------------------------------------------------------------------------
3070 subroutine ebend(etheta)
3072 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3073 C angles gamma and its derivatives in consecutive thetas and gammas.
3075 implicit real*8 (a-h,o-z)
3076 include 'DIMENSIONS'
3077 include 'sizesclu.dat'
3078 include 'COMMON.LOCAL'
3079 include 'COMMON.GEO'
3080 include 'COMMON.INTERACT'
3081 include 'COMMON.DERIV'
3082 include 'COMMON.VAR'
3083 include 'COMMON.CHAIN'
3084 include 'COMMON.IOUNITS'
3085 include 'COMMON.NAMES'
3086 include 'COMMON.FFIELD'
3087 common /calcthet/ term1,term2,termm,diffak,ratak,
3088 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3089 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3090 double precision y(2),z(2)
3092 time11=dexp(-2*time)
3095 c write (iout,*) "nres",nres
3096 c write (*,'(a,i2)') 'EBEND ICG=',icg
3097 c write (iout,*) ithet_start,ithet_end
3098 do i=ithet_start,ithet_end
3099 C Zero the energy function and its derivative at 0 or pi.
3100 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3102 c if (i.gt.ithet_start .and.
3103 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3104 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3112 c if (i.lt.nres .and. itel(i).ne.0) then
3124 call proc_proc(phii,icrc)
3125 if (icrc.eq.1) phii=150.0
3139 call proc_proc(phii1,icrc)
3140 if (icrc.eq.1) phii1=150.0
3152 C Calculate the "mean" value of theta from the part of the distribution
3153 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3154 C In following comments this theta will be referred to as t_c.
3155 thet_pred_mean=0.0d0
3159 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3161 c write (iout,*) "thet_pred_mean",thet_pred_mean
3162 dthett=thet_pred_mean*ssd
3163 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3164 c write (iout,*) "thet_pred_mean",thet_pred_mean
3165 C Derivatives of the "mean" values in gamma1 and gamma2.
3166 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3167 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3168 if (theta(i).gt.pi-delta) then
3169 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3171 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3172 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3173 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3175 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3177 else if (theta(i).lt.delta) then
3178 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3179 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3180 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3182 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3183 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3186 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3189 etheta=etheta+ethetai
3190 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3191 c & rad2deg*phii,rad2deg*phii1,ethetai
3192 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3193 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3194 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3197 C Ufff.... We've done all this!!!
3200 C---------------------------------------------------------------------------
3201 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3203 implicit real*8 (a-h,o-z)
3204 include 'DIMENSIONS'
3205 include 'COMMON.LOCAL'
3206 include 'COMMON.IOUNITS'
3207 common /calcthet/ term1,term2,termm,diffak,ratak,
3208 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3209 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3210 C Calculate the contributions to both Gaussian lobes.
3211 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3212 C The "polynomial part" of the "standard deviation" of this part of
3216 sig=sig*thet_pred_mean+polthet(j,it)
3218 C Derivative of the "interior part" of the "standard deviation of the"
3219 C gamma-dependent Gaussian lobe in t_c.
3220 sigtc=3*polthet(3,it)
3222 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3225 C Set the parameters of both Gaussian lobes of the distribution.
3226 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3227 fac=sig*sig+sigc0(it)
3230 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3231 sigsqtc=-4.0D0*sigcsq*sigtc
3232 c print *,i,sig,sigtc,sigsqtc
3233 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3234 sigtc=-sigtc/(fac*fac)
3235 C Following variable is sigma(t_c)**(-2)
3236 sigcsq=sigcsq*sigcsq
3238 sig0inv=1.0D0/sig0i**2
3239 delthec=thetai-thet_pred_mean
3240 delthe0=thetai-theta0i
3241 term1=-0.5D0*sigcsq*delthec*delthec
3242 term2=-0.5D0*sig0inv*delthe0*delthe0
3243 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3244 C NaNs in taking the logarithm. We extract the largest exponent which is added
3245 C to the energy (this being the log of the distribution) at the end of energy
3246 C term evaluation for this virtual-bond angle.
3247 if (term1.gt.term2) then
3249 term2=dexp(term2-termm)
3253 term1=dexp(term1-termm)
3256 C The ratio between the gamma-independent and gamma-dependent lobes of
3257 C the distribution is a Gaussian function of thet_pred_mean too.
3258 diffak=gthet(2,it)-thet_pred_mean
3259 ratak=diffak/gthet(3,it)**2
3260 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3261 C Let's differentiate it in thet_pred_mean NOW.
3263 C Now put together the distribution terms to make complete distribution.
3264 termexp=term1+ak*term2
3265 termpre=sigc+ak*sig0i
3266 C Contribution of the bending energy from this theta is just the -log of
3267 C the sum of the contributions from the two lobes and the pre-exponential
3268 C factor. Simple enough, isn't it?
3269 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3270 C NOW the derivatives!!!
3271 C 6/6/97 Take into account the deformation.
3272 E_theta=(delthec*sigcsq*term1
3273 & +ak*delthe0*sig0inv*term2)/termexp
3274 E_tc=((sigtc+aktc*sig0i)/termpre
3275 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3276 & aktc*term2)/termexp)
3279 c-----------------------------------------------------------------------------
3280 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3281 implicit real*8 (a-h,o-z)
3282 include 'DIMENSIONS'
3283 include 'COMMON.LOCAL'
3284 include 'COMMON.IOUNITS'
3285 common /calcthet/ term1,term2,termm,diffak,ratak,
3286 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3287 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3288 delthec=thetai-thet_pred_mean
3289 delthe0=thetai-theta0i
3290 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3291 t3 = thetai-thet_pred_mean
3295 t14 = t12+t6*sigsqtc
3297 t21 = thetai-theta0i
3303 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3304 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3305 & *(-t12*t9-ak*sig0inv*t27)
3309 C--------------------------------------------------------------------------
3310 subroutine ebend(etheta)
3312 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3313 C angles gamma and its derivatives in consecutive thetas and gammas.
3314 C ab initio-derived potentials from
3315 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3317 implicit real*8 (a-h,o-z)
3318 include 'DIMENSIONS'
3319 include 'COMMON.LOCAL'
3320 include 'COMMON.GEO'
3321 include 'COMMON.INTERACT'
3322 include 'COMMON.DERIV'
3323 include 'COMMON.VAR'
3324 include 'COMMON.CHAIN'
3325 include 'COMMON.IOUNITS'
3326 include 'COMMON.NAMES'
3327 include 'COMMON.FFIELD'
3328 include 'COMMON.CONTROL'
3329 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3330 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3331 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3332 & sinph1ph2(maxdouble,maxdouble)
3333 logical lprn /.false./, lprn1 /.false./
3335 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3336 do i=ithet_start,ithet_end
3340 theti2=0.5d0*theta(i)
3341 ityp2=ithetyp(itype(i-1))
3343 coskt(k)=dcos(k*theti2)
3344 sinkt(k)=dsin(k*theti2)
3349 if (phii.ne.phii) phii=150.0
3353 ityp1=ithetyp(itype(i-2))
3355 cosph1(k)=dcos(k*phii)
3356 sinph1(k)=dsin(k*phii)
3369 if (phii1.ne.phii1) phii1=150.0
3374 ityp3=ithetyp(itype(i))
3376 cosph2(k)=dcos(k*phii1)
3377 sinph2(k)=dsin(k*phii1)
3387 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3388 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3390 ethetai=aa0thet(ityp1,ityp2,ityp3)
3393 ccl=cosph1(l)*cosph2(k-l)
3394 ssl=sinph1(l)*sinph2(k-l)
3395 scl=sinph1(l)*cosph2(k-l)
3396 csl=cosph1(l)*sinph2(k-l)
3397 cosph1ph2(l,k)=ccl-ssl
3398 cosph1ph2(k,l)=ccl+ssl
3399 sinph1ph2(l,k)=scl+csl
3400 sinph1ph2(k,l)=scl-csl
3404 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3405 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3406 write (iout,*) "coskt and sinkt"
3408 write (iout,*) k,coskt(k),sinkt(k)
3412 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3413 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3416 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3417 & " ethetai",ethetai
3420 write (iout,*) "cosph and sinph"
3422 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3424 write (iout,*) "cosph1ph2 and sinph2ph2"
3427 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3428 & sinph1ph2(l,k),sinph1ph2(k,l)
3431 write(iout,*) "ethetai",ethetai
3435 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3436 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3437 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3438 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3439 ethetai=ethetai+sinkt(m)*aux
3440 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3441 dephii=dephii+k*sinkt(m)*(
3442 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3443 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3444 dephii1=dephii1+k*sinkt(m)*(
3445 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3446 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3448 & write (iout,*) "m",m," k",k," bbthet",
3449 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3450 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3451 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3452 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3456 & write(iout,*) "ethetai",ethetai
3460 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3461 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3462 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3463 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3464 ethetai=ethetai+sinkt(m)*aux
3465 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3466 dephii=dephii+l*sinkt(m)*(
3467 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3468 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3469 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3470 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3471 dephii1=dephii1+(k-l)*sinkt(m)*(
3472 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3473 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3474 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3475 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3477 write (iout,*) "m",m," k",k," l",l," ffthet",
3478 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3479 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3480 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3481 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3482 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3483 & cosph1ph2(k,l)*sinkt(m),
3484 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3490 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3491 & i,theta(i)*rad2deg,phii*rad2deg,
3492 & phii1*rad2deg,ethetai
3493 etheta=etheta+ethetai
3494 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3495 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3496 gloc(nphi+i-2,icg)=wang*dethetai
3502 c-----------------------------------------------------------------------------
3503 subroutine esc(escloc)
3504 C Calculate the local energy of a side chain and its derivatives in the
3505 C corresponding virtual-bond valence angles THETA and the spherical angles
3507 implicit real*8 (a-h,o-z)
3508 include 'DIMENSIONS'
3509 include 'sizesclu.dat'
3510 include 'COMMON.GEO'
3511 include 'COMMON.LOCAL'
3512 include 'COMMON.VAR'
3513 include 'COMMON.INTERACT'
3514 include 'COMMON.DERIV'
3515 include 'COMMON.CHAIN'
3516 include 'COMMON.IOUNITS'
3517 include 'COMMON.NAMES'
3518 include 'COMMON.FFIELD'
3519 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3520 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3521 common /sccalc/ time11,time12,time112,theti,it,nlobit
3524 c write (iout,'(a)') 'ESC'
3525 do i=loc_start,loc_end
3527 if (it.eq.10) goto 1
3529 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3530 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3531 theti=theta(i+1)-pipol
3535 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3537 if (x(2).gt.pi-delta) then
3541 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3543 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3544 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3546 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3547 & ddersc0(1),dersc(1))
3548 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3549 & ddersc0(3),dersc(3))
3551 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3553 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3554 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3555 & dersc0(2),esclocbi,dersc02)
3556 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3558 call splinthet(x(2),0.5d0*delta,ss,ssd)
3563 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3565 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3566 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3568 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3570 c write (iout,*) escloci
3571 else if (x(2).lt.delta) then
3575 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3577 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3578 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3580 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3581 & ddersc0(1),dersc(1))
3582 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3583 & ddersc0(3),dersc(3))
3585 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3587 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3588 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3589 & dersc0(2),esclocbi,dersc02)
3590 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3595 call splinthet(x(2),0.5d0*delta,ss,ssd)
3597 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3599 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3600 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3602 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3603 c write (iout,*) escloci
3605 call enesc(x,escloci,dersc,ddummy,.false.)
3608 escloc=escloc+escloci
3609 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3611 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3613 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3614 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3619 C---------------------------------------------------------------------------
3620 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3621 implicit real*8 (a-h,o-z)
3622 include 'DIMENSIONS'
3623 include 'COMMON.GEO'
3624 include 'COMMON.LOCAL'
3625 include 'COMMON.IOUNITS'
3626 common /sccalc/ time11,time12,time112,theti,it,nlobit
3627 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3628 double precision contr(maxlob,-1:1)
3630 c write (iout,*) 'it=',it,' nlobit=',nlobit
3634 if (mixed) ddersc(j)=0.0d0
3638 C Because of periodicity of the dependence of the SC energy in omega we have
3639 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3640 C To avoid underflows, first compute & store the exponents.
3648 z(k)=x(k)-censc(k,j,it)
3653 Axk=Axk+gaussc(l,k,j,it)*z(l)
3659 expfac=expfac+Ax(k,j,iii)*z(k)
3667 C As in the case of ebend, we want to avoid underflows in exponentiation and
3668 C subsequent NaNs and INFs in energy calculation.
3669 C Find the largest exponent
3673 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3677 cd print *,'it=',it,' emin=',emin
3679 C Compute the contribution to SC energy and derivatives
3683 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3684 cd print *,'j=',j,' expfac=',expfac
3685 escloc_i=escloc_i+expfac
3687 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3691 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3692 & +gaussc(k,2,j,it))*expfac
3699 dersc(1)=dersc(1)/cos(theti)**2
3700 ddersc(1)=ddersc(1)/cos(theti)**2
3703 escloci=-(dlog(escloc_i)-emin)
3705 dersc(j)=dersc(j)/escloc_i
3709 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3714 C------------------------------------------------------------------------------
3715 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3716 implicit real*8 (a-h,o-z)
3717 include 'DIMENSIONS'
3718 include 'COMMON.GEO'
3719 include 'COMMON.LOCAL'
3720 include 'COMMON.IOUNITS'
3721 common /sccalc/ time11,time12,time112,theti,it,nlobit
3722 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3723 double precision contr(maxlob)
3734 z(k)=x(k)-censc(k,j,it)
3740 Axk=Axk+gaussc(l,k,j,it)*z(l)
3746 expfac=expfac+Ax(k,j)*z(k)
3751 C As in the case of ebend, we want to avoid underflows in exponentiation and
3752 C subsequent NaNs and INFs in energy calculation.
3753 C Find the largest exponent
3756 if (emin.gt.contr(j)) emin=contr(j)
3760 C Compute the contribution to SC energy and derivatives
3764 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3765 escloc_i=escloc_i+expfac
3767 dersc(k)=dersc(k)+Ax(k,j)*expfac
3769 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3770 & +gaussc(1,2,j,it))*expfac
3774 dersc(1)=dersc(1)/cos(theti)**2
3775 dersc12=dersc12/cos(theti)**2
3776 escloci=-(dlog(escloc_i)-emin)
3778 dersc(j)=dersc(j)/escloc_i
3780 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3784 c----------------------------------------------------------------------------------
3785 subroutine esc(escloc)
3786 C Calculate the local energy of a side chain and its derivatives in the
3787 C corresponding virtual-bond valence angles THETA and the spherical angles
3788 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3789 C added by Urszula Kozlowska. 07/11/2007
3791 implicit real*8 (a-h,o-z)
3792 include 'DIMENSIONS'
3793 include 'COMMON.GEO'
3794 include 'COMMON.LOCAL'
3795 include 'COMMON.VAR'
3796 include 'COMMON.SCROT'
3797 include 'COMMON.INTERACT'
3798 include 'COMMON.DERIV'
3799 include 'COMMON.CHAIN'
3800 include 'COMMON.IOUNITS'
3801 include 'COMMON.NAMES'
3802 include 'COMMON.FFIELD'
3803 include 'COMMON.CONTROL'
3804 include 'COMMON.VECTORS'
3805 double precision x_prime(3),y_prime(3),z_prime(3)
3806 & , sumene,dsc_i,dp2_i,x(65),
3807 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3808 & de_dxx,de_dyy,de_dzz,de_dt
3809 double precision s1_t,s1_6_t,s2_t,s2_6_t
3811 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3812 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3813 & dt_dCi(3),dt_dCi1(3)
3814 common /sccalc/ time11,time12,time112,theti,it,nlobit
3817 do i=loc_start,loc_end
3818 costtab(i+1) =dcos(theta(i+1))
3819 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3820 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3821 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3822 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3823 cosfac=dsqrt(cosfac2)
3824 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3825 sinfac=dsqrt(sinfac2)
3827 if (it.eq.10) goto 1
3829 C Compute the axes of tghe local cartesian coordinates system; store in
3830 c x_prime, y_prime and z_prime
3837 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3838 C & dc_norm(3,i+nres)
3840 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3841 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3844 z_prime(j) = -uz(j,i-1)
3847 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3848 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3849 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3850 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3851 c & " xy",scalar(x_prime(1),y_prime(1)),
3852 c & " xz",scalar(x_prime(1),z_prime(1)),
3853 c & " yy",scalar(y_prime(1),y_prime(1)),
3854 c & " yz",scalar(y_prime(1),z_prime(1)),
3855 c & " zz",scalar(z_prime(1),z_prime(1))
3857 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3858 C to local coordinate system. Store in xx, yy, zz.
3864 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3865 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3866 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3873 C Compute the energy of the ith side cbain
3875 c write (2,*) "xx",xx," yy",yy," zz",zz
3878 x(j) = sc_parmin(j,it)
3881 Cc diagnostics - remove later
3883 yy1 = dsin(alph(2))*dcos(omeg(2))
3884 zz1 = -dsin(alph(2))*dsin(omeg(2))
3885 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3886 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3888 C," --- ", xx_w,yy_w,zz_w
3891 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3892 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3894 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3895 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3897 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3898 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3899 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3900 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3901 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3903 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3904 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3905 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3906 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3907 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3909 dsc_i = 0.743d0+x(61)
3911 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3912 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3913 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3914 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3915 s1=(1+x(63))/(0.1d0 + dscp1)
3916 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3917 s2=(1+x(65))/(0.1d0 + dscp2)
3918 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3919 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3920 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3921 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3923 c & dscp1,dscp2,sumene
3924 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3925 escloc = escloc + sumene
3926 c write (2,*) "escloc",escloc
3927 if (.not. calc_grad) goto 1
3930 C This section to check the numerical derivatives of the energy of ith side
3931 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3932 C #define DEBUG in the code to turn it on.
3934 write (2,*) "sumene =",sumene
3938 write (2,*) xx,yy,zz
3939 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3940 de_dxx_num=(sumenep-sumene)/aincr
3942 write (2,*) "xx+ sumene from enesc=",sumenep
3945 write (2,*) xx,yy,zz
3946 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3947 de_dyy_num=(sumenep-sumene)/aincr
3949 write (2,*) "yy+ sumene from enesc=",sumenep
3952 write (2,*) xx,yy,zz
3953 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3954 de_dzz_num=(sumenep-sumene)/aincr
3956 write (2,*) "zz+ sumene from enesc=",sumenep
3957 costsave=cost2tab(i+1)
3958 sintsave=sint2tab(i+1)
3959 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
3960 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
3961 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3962 de_dt_num=(sumenep-sumene)/aincr
3963 write (2,*) " t+ sumene from enesc=",sumenep
3964 cost2tab(i+1)=costsave
3965 sint2tab(i+1)=sintsave
3966 C End of diagnostics section.
3969 C Compute the gradient of esc
3971 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
3972 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
3973 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
3974 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
3975 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
3976 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
3977 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
3978 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
3979 pom1=(sumene3*sint2tab(i+1)+sumene1)
3980 & *(pom_s1/dscp1+pom_s16*dscp1**4)
3981 pom2=(sumene4*cost2tab(i+1)+sumene2)
3982 & *(pom_s2/dscp2+pom_s26*dscp2**4)
3983 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
3984 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
3985 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
3987 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
3988 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
3989 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
3991 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
3992 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
3993 & +(pom1+pom2)*pom_dx
3995 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
3998 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
3999 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4000 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4002 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4003 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4004 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4005 & +x(59)*zz**2 +x(60)*xx*zz
4006 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4007 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4008 & +(pom1-pom2)*pom_dy
4010 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4013 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4014 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4015 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4016 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4017 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4018 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4019 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4020 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4022 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4025 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4026 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4027 & +pom1*pom_dt1+pom2*pom_dt2
4029 write(2,*), "de_dt = ", de_dt,de_dt_num
4033 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4034 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4035 cosfac2xx=cosfac2*xx
4036 sinfac2yy=sinfac2*yy
4038 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4040 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4042 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4043 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4044 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4045 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4046 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4047 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4048 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4049 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4050 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4051 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4055 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4056 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4059 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4060 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4061 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4063 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4064 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4068 dXX_Ctab(k,i)=dXX_Ci(k)
4069 dXX_C1tab(k,i)=dXX_Ci1(k)
4070 dYY_Ctab(k,i)=dYY_Ci(k)
4071 dYY_C1tab(k,i)=dYY_Ci1(k)
4072 dZZ_Ctab(k,i)=dZZ_Ci(k)
4073 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4074 dXX_XYZtab(k,i)=dXX_XYZ(k)
4075 dYY_XYZtab(k,i)=dYY_XYZ(k)
4076 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4080 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4081 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4082 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4083 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4084 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4086 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4087 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4088 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4089 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4090 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4091 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4092 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4093 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4095 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4096 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4098 C to check gradient call subroutine check_grad
4105 c------------------------------------------------------------------------------
4106 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4108 C This procedure calculates two-body contact function g(rij) and its derivative:
4111 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4114 C where x=(rij-r0ij)/delta
4116 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4119 double precision rij,r0ij,eps0ij,fcont,fprimcont
4120 double precision x,x2,x4,delta
4124 if (x.lt.-1.0D0) then
4127 else if (x.le.1.0D0) then
4130 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4131 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4138 c------------------------------------------------------------------------------
4139 subroutine splinthet(theti,delta,ss,ssder)
4140 implicit real*8 (a-h,o-z)
4141 include 'DIMENSIONS'
4142 include 'sizesclu.dat'
4143 include 'COMMON.VAR'
4144 include 'COMMON.GEO'
4147 if (theti.gt.pipol) then
4148 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4150 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4155 c------------------------------------------------------------------------------
4156 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4158 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4159 double precision ksi,ksi2,ksi3,a1,a2,a3
4160 a1=fprim0*delta/(f1-f0)
4166 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4167 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4170 c------------------------------------------------------------------------------
4171 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4173 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4174 double precision ksi,ksi2,ksi3,a1,a2,a3
4179 a2=3*(f1x-f0x)-2*fprim0x*delta
4180 a3=fprim0x*delta-2*(f1x-f0x)
4181 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4184 C-----------------------------------------------------------------------------
4186 C-----------------------------------------------------------------------------
4187 subroutine etor(etors,edihcnstr,fact)
4188 implicit real*8 (a-h,o-z)
4189 include 'DIMENSIONS'
4190 include 'sizesclu.dat'
4191 include 'COMMON.VAR'
4192 include 'COMMON.GEO'
4193 include 'COMMON.LOCAL'
4194 include 'COMMON.TORSION'
4195 include 'COMMON.INTERACT'
4196 include 'COMMON.DERIV'
4197 include 'COMMON.CHAIN'
4198 include 'COMMON.NAMES'
4199 include 'COMMON.IOUNITS'
4200 include 'COMMON.FFIELD'
4201 include 'COMMON.TORCNSTR'
4203 C Set lprn=.true. for debugging
4207 do i=iphi_start,iphi_end
4208 itori=itortyp(itype(i-2))
4209 itori1=itortyp(itype(i-1))
4212 C Proline-Proline pair is a special case...
4213 if (itori.eq.3 .and. itori1.eq.3) then
4214 if (phii.gt.-dwapi3) then
4216 fac=1.0D0/(1.0D0-cosphi)
4217 etorsi=v1(1,3,3)*fac
4218 etorsi=etorsi+etorsi
4219 etors=etors+etorsi-v1(1,3,3)
4220 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4223 v1ij=v1(j+1,itori,itori1)
4224 v2ij=v2(j+1,itori,itori1)
4227 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4228 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4232 v1ij=v1(j,itori,itori1)
4233 v2ij=v2(j,itori,itori1)
4236 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4237 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4241 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4242 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4243 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4244 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4245 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4247 ! 6/20/98 - dihedral angle constraints
4250 itori=idih_constr(i)
4252 difi=pinorm(phii-phi0(i))
4253 if (difi.gt.drange(i)) then
4255 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4256 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4257 else if (difi.lt.-drange(i)) then
4259 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4260 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4262 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4263 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4265 write (iout,*) 'edihcnstr',edihcnstr
4268 c------------------------------------------------------------------------------
4270 subroutine etor(etors,edihcnstr,fact)
4271 implicit real*8 (a-h,o-z)
4272 include 'DIMENSIONS'
4273 include 'sizesclu.dat'
4274 include 'COMMON.VAR'
4275 include 'COMMON.GEO'
4276 include 'COMMON.LOCAL'
4277 include 'COMMON.TORSION'
4278 include 'COMMON.INTERACT'
4279 include 'COMMON.DERIV'
4280 include 'COMMON.CHAIN'
4281 include 'COMMON.NAMES'
4282 include 'COMMON.IOUNITS'
4283 include 'COMMON.FFIELD'
4284 include 'COMMON.TORCNSTR'
4286 C Set lprn=.true. for debugging
4290 do i=iphi_start,iphi_end
4291 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4292 itori=itortyp(itype(i-2))
4293 itori1=itortyp(itype(i-1))
4296 C Regular cosine and sine terms
4297 do j=1,nterm(itori,itori1)
4298 v1ij=v1(j,itori,itori1)
4299 v2ij=v2(j,itori,itori1)
4302 etors=etors+v1ij*cosphi+v2ij*sinphi
4303 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4307 C E = SUM ----------------------------------- - v1
4308 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4310 cosphi=dcos(0.5d0*phii)
4311 sinphi=dsin(0.5d0*phii)
4312 do j=1,nlor(itori,itori1)
4313 vl1ij=vlor1(j,itori,itori1)
4314 vl2ij=vlor2(j,itori,itori1)
4315 vl3ij=vlor3(j,itori,itori1)
4316 pom=vl2ij*cosphi+vl3ij*sinphi
4317 pom1=1.0d0/(pom*pom+1.0d0)
4318 etors=etors+vl1ij*pom1
4320 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4322 C Subtract the constant term
4323 etors=etors-v0(itori,itori1)
4325 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4326 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4327 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4328 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4329 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4332 ! 6/20/98 - dihedral angle constraints
4334 c write (iout,*) "Dihedral angle restraint energy"
4336 itori=idih_constr(i)
4338 difi=pinorm(phii-phi0(i))
4339 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
4340 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
4341 if (difi.gt.drange(i)) then
4343 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4344 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4345 c write (iout,*) 0.25d0*ftors*difi**4
4346 else if (difi.lt.-drange(i)) then
4348 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4349 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4350 c write (iout,*) 0.25d0*ftors*difi**4
4353 c write (iout,*) 'edihcnstr',edihcnstr
4356 c----------------------------------------------------------------------------
4357 subroutine etor_d(etors_d,fact2)
4358 C 6/23/01 Compute double torsional energy
4359 implicit real*8 (a-h,o-z)
4360 include 'DIMENSIONS'
4361 include 'sizesclu.dat'
4362 include 'COMMON.VAR'
4363 include 'COMMON.GEO'
4364 include 'COMMON.LOCAL'
4365 include 'COMMON.TORSION'
4366 include 'COMMON.INTERACT'
4367 include 'COMMON.DERIV'
4368 include 'COMMON.CHAIN'
4369 include 'COMMON.NAMES'
4370 include 'COMMON.IOUNITS'
4371 include 'COMMON.FFIELD'
4372 include 'COMMON.TORCNSTR'
4374 C Set lprn=.true. for debugging
4378 do i=iphi_start,iphi_end-1
4379 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4381 itori=itortyp(itype(i-2))
4382 itori1=itortyp(itype(i-1))
4383 itori2=itortyp(itype(i))
4388 C Regular cosine and sine terms
4389 do j=1,ntermd_1(itori,itori1,itori2)
4390 v1cij=v1c(1,j,itori,itori1,itori2)
4391 v1sij=v1s(1,j,itori,itori1,itori2)
4392 v2cij=v1c(2,j,itori,itori1,itori2)
4393 v2sij=v1s(2,j,itori,itori1,itori2)
4394 cosphi1=dcos(j*phii)
4395 sinphi1=dsin(j*phii)
4396 cosphi2=dcos(j*phii1)
4397 sinphi2=dsin(j*phii1)
4398 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4399 & v2cij*cosphi2+v2sij*sinphi2
4400 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4401 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4403 do k=2,ntermd_2(itori,itori1,itori2)
4405 v1cdij = v2c(k,l,itori,itori1,itori2)
4406 v2cdij = v2c(l,k,itori,itori1,itori2)
4407 v1sdij = v2s(k,l,itori,itori1,itori2)
4408 v2sdij = v2s(l,k,itori,itori1,itori2)
4409 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4410 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4411 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4412 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4413 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4414 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4415 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4416 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4417 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4418 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4421 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4422 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4428 c------------------------------------------------------------------------------
4429 subroutine eback_sc_corr(esccor,fact)
4430 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4431 c conformational states; temporarily implemented as differences
4432 c between UNRES torsional potentials (dependent on three types of
4433 c residues) and the torsional potentials dependent on all 20 types
4434 c of residues computed from AM1 energy surfaces of terminally-blocked
4435 c amino-acid residues.
4436 implicit real*8 (a-h,o-z)
4437 include 'DIMENSIONS'
4438 include 'COMMON.VAR'
4439 include 'COMMON.GEO'
4440 include 'COMMON.LOCAL'
4441 include 'COMMON.TORSION'
4442 include 'COMMON.SCCOR'
4443 include 'COMMON.INTERACT'
4444 include 'COMMON.DERIV'
4445 include 'COMMON.CHAIN'
4446 include 'COMMON.NAMES'
4447 include 'COMMON.IOUNITS'
4448 include 'COMMON.FFIELD'
4449 include 'COMMON.CONTROL'
4451 C Set lprn=.true. for debugging
4454 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4456 do i=itau_start,itau_end
4458 isccori=isccortyp(itype(i-2))
4459 isccori1=isccortyp(itype(i-1))
4461 cccc Added 9 May 2012
4462 cc Tauangle is torsional engle depending on the value of first digit
4463 c(see comment below)
4464 cc Omicron is flat angle depending on the value of first digit
4465 c(see comment below)
4468 do intertyp=1,3 !intertyp
4469 cc Added 09 May 2012 (Adasko)
4470 cc Intertyp means interaction type of backbone mainchain correlation:
4471 c 1 = SC...Ca...Ca...Ca
4472 c 2 = Ca...Ca...Ca...SC
4473 c 3 = SC...Ca...Ca...SCi
4475 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4476 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4477 & (itype(i-1).eq.21)))
4478 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4479 & .or.(itype(i-2).eq.21)))
4480 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4481 & (itype(i-1).eq.21)))) cycle
4482 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4483 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4485 do j=1,nterm_sccor(isccori,isccori1)
4486 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4487 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4488 cosphi=dcos(j*tauangle(intertyp,i))
4489 sinphi=dsin(j*tauangle(intertyp,i))
4490 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4491 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4493 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4494 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4495 c &gloc_sc(intertyp,i-3,icg)
4497 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4498 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4499 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4500 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4501 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4507 c------------------------------------------------------------------------------
4508 subroutine multibody(ecorr)
4509 C This subroutine calculates multi-body contributions to energy following
4510 C the idea of Skolnick et al. If side chains I and J make a contact and
4511 C at the same time side chains I+1 and J+1 make a contact, an extra
4512 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4513 implicit real*8 (a-h,o-z)
4514 include 'DIMENSIONS'
4515 include 'COMMON.IOUNITS'
4516 include 'COMMON.DERIV'
4517 include 'COMMON.INTERACT'
4518 include 'COMMON.CONTACTS'
4519 double precision gx(3),gx1(3)
4522 C Set lprn=.true. for debugging
4526 write (iout,'(a)') 'Contact function values:'
4528 write (iout,'(i2,20(1x,i2,f10.5))')
4529 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4544 num_conti=num_cont(i)
4545 num_conti1=num_cont(i1)
4550 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4551 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4552 cd & ' ishift=',ishift
4553 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4554 C The system gains extra energy.
4555 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4556 endif ! j1==j+-ishift
4565 c------------------------------------------------------------------------------
4566 double precision function esccorr(i,j,k,l,jj,kk)
4567 implicit real*8 (a-h,o-z)
4568 include 'DIMENSIONS'
4569 include 'COMMON.IOUNITS'
4570 include 'COMMON.DERIV'
4571 include 'COMMON.INTERACT'
4572 include 'COMMON.CONTACTS'
4573 double precision gx(3),gx1(3)
4578 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4579 C Calculate the multi-body contribution to energy.
4580 C Calculate multi-body contributions to the gradient.
4581 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4582 cd & k,l,(gacont(m,kk,k),m=1,3)
4584 gx(m) =ekl*gacont(m,jj,i)
4585 gx1(m)=eij*gacont(m,kk,k)
4586 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4587 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4588 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4589 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4593 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4598 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4604 c------------------------------------------------------------------------------
4606 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4607 implicit real*8 (a-h,o-z)
4608 include 'DIMENSIONS'
4609 integer dimen1,dimen2,atom,indx
4610 double precision buffer(dimen1,dimen2)
4611 double precision zapas
4612 common /contacts_hb/ zapas(3,20,maxres,7),
4613 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4614 & num_cont_hb(maxres),jcont_hb(20,maxres)
4615 num_kont=num_cont_hb(atom)
4619 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4622 buffer(i,indx+22)=facont_hb(i,atom)
4623 buffer(i,indx+23)=ees0p(i,atom)
4624 buffer(i,indx+24)=ees0m(i,atom)
4625 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4627 buffer(1,indx+26)=dfloat(num_kont)
4630 c------------------------------------------------------------------------------
4631 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4632 implicit real*8 (a-h,o-z)
4633 include 'DIMENSIONS'
4634 integer dimen1,dimen2,atom,indx
4635 double precision buffer(dimen1,dimen2)
4636 double precision zapas
4637 common /contacts_hb/ zapas(3,20,maxres,7),
4638 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4639 & num_cont_hb(maxres),jcont_hb(20,maxres)
4640 num_kont=buffer(1,indx+26)
4641 num_kont_old=num_cont_hb(atom)
4642 num_cont_hb(atom)=num_kont+num_kont_old
4647 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4650 facont_hb(ii,atom)=buffer(i,indx+22)
4651 ees0p(ii,atom)=buffer(i,indx+23)
4652 ees0m(ii,atom)=buffer(i,indx+24)
4653 jcont_hb(ii,atom)=buffer(i,indx+25)
4657 c------------------------------------------------------------------------------
4659 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4660 C This subroutine calculates multi-body contributions to hydrogen-bonding
4661 implicit real*8 (a-h,o-z)
4662 include 'DIMENSIONS'
4663 include 'sizesclu.dat'
4664 include 'COMMON.IOUNITS'
4666 include 'COMMON.INFO'
4668 include 'COMMON.FFIELD'
4669 include 'COMMON.DERIV'
4670 include 'COMMON.INTERACT'
4671 include 'COMMON.CONTACTS'
4673 parameter (max_cont=maxconts)
4674 parameter (max_dim=2*(8*3+2))
4675 parameter (msglen1=max_cont*max_dim*4)
4676 parameter (msglen2=2*msglen1)
4677 integer source,CorrelType,CorrelID,Error
4678 double precision buffer(max_cont,max_dim)
4680 double precision gx(3),gx1(3)
4683 C Set lprn=.true. for debugging
4688 if (fgProcs.le.1) goto 30
4690 write (iout,'(a)') 'Contact function values:'
4692 write (iout,'(2i3,50(1x,i2,f5.2))')
4693 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4694 & j=1,num_cont_hb(i))
4697 C Caution! Following code assumes that electrostatic interactions concerning
4698 C a given atom are split among at most two processors!
4708 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4711 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4712 if (MyRank.gt.0) then
4713 C Send correlation contributions to the preceding processor
4715 nn=num_cont_hb(iatel_s)
4716 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4717 cd write (iout,*) 'The BUFFER array:'
4719 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4721 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4723 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4724 C Clear the contacts of the atom passed to the neighboring processor
4725 nn=num_cont_hb(iatel_s+1)
4727 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4729 num_cont_hb(iatel_s)=0
4731 cd write (iout,*) 'Processor ',MyID,MyRank,
4732 cd & ' is sending correlation contribution to processor',MyID-1,
4733 cd & ' msglen=',msglen
4734 cd write (*,*) 'Processor ',MyID,MyRank,
4735 cd & ' is sending correlation contribution to processor',MyID-1,
4736 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4737 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4738 cd write (iout,*) 'Processor ',MyID,
4739 cd & ' has sent correlation contribution to processor',MyID-1,
4740 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4741 cd write (*,*) 'Processor ',MyID,
4742 cd & ' has sent correlation contribution to processor',MyID-1,
4743 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4745 endif ! (MyRank.gt.0)
4749 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4750 if (MyRank.lt.fgProcs-1) then
4751 C Receive correlation contributions from the next processor
4753 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4754 cd write (iout,*) 'Processor',MyID,
4755 cd & ' is receiving correlation contribution from processor',MyID+1,
4756 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4757 cd write (*,*) 'Processor',MyID,
4758 cd & ' is receiving correlation contribution from processor',MyID+1,
4759 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4761 do while (nbytes.le.0)
4762 call mp_probe(MyID+1,CorrelType,nbytes)
4764 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4765 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4766 cd write (iout,*) 'Processor',MyID,
4767 cd & ' has received correlation contribution from processor',MyID+1,
4768 cd & ' msglen=',msglen,' nbytes=',nbytes
4769 cd write (iout,*) 'The received BUFFER array:'
4771 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4773 if (msglen.eq.msglen1) then
4774 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4775 else if (msglen.eq.msglen2) then
4776 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4777 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4780 & 'ERROR!!!! message length changed while processing correlations.'
4782 & 'ERROR!!!! message length changed while processing correlations.'
4783 call mp_stopall(Error)
4784 endif ! msglen.eq.msglen1
4785 endif ! MyRank.lt.fgProcs-1
4792 write (iout,'(a)') 'Contact function values:'
4794 write (iout,'(2i3,50(1x,i2,f5.2))')
4795 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4796 & j=1,num_cont_hb(i))
4800 C Remove the loop below after debugging !!!
4807 C Calculate the local-electrostatic correlation terms
4808 do i=iatel_s,iatel_e+1
4810 num_conti=num_cont_hb(i)
4811 num_conti1=num_cont_hb(i+1)
4816 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4817 c & ' jj=',jj,' kk=',kk
4818 if (j1.eq.j+1 .or. j1.eq.j-1) then
4819 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4820 C The system gains extra energy.
4821 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4823 else if (j1.eq.j) then
4824 C Contacts I-J and I-(J+1) occur simultaneously.
4825 C The system loses extra energy.
4826 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4831 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4832 c & ' jj=',jj,' kk=',kk
4834 C Contacts I-J and (I+1)-J occur simultaneously.
4835 C The system loses extra energy.
4836 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4843 c------------------------------------------------------------------------------
4844 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4846 C This subroutine calculates multi-body contributions to hydrogen-bonding
4847 implicit real*8 (a-h,o-z)
4848 include 'DIMENSIONS'
4849 include 'sizesclu.dat'
4850 include 'COMMON.IOUNITS'
4852 include 'COMMON.INFO'
4854 include 'COMMON.FFIELD'
4855 include 'COMMON.DERIV'
4856 include 'COMMON.INTERACT'
4857 include 'COMMON.CONTACTS'
4859 parameter (max_cont=maxconts)
4860 parameter (max_dim=2*(8*3+2))
4861 parameter (msglen1=max_cont*max_dim*4)
4862 parameter (msglen2=2*msglen1)
4863 integer source,CorrelType,CorrelID,Error
4864 double precision buffer(max_cont,max_dim)
4866 double precision gx(3),gx1(3)
4869 C Set lprn=.true. for debugging
4875 if (fgProcs.le.1) goto 30
4877 write (iout,'(a)') 'Contact function values:'
4879 write (iout,'(2i3,50(1x,i2,f5.2))')
4880 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4881 & j=1,num_cont_hb(i))
4884 C Caution! Following code assumes that electrostatic interactions concerning
4885 C a given atom are split among at most two processors!
4895 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4898 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4899 if (MyRank.gt.0) then
4900 C Send correlation contributions to the preceding processor
4902 nn=num_cont_hb(iatel_s)
4903 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4904 cd write (iout,*) 'The BUFFER array:'
4906 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4908 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4910 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4911 C Clear the contacts of the atom passed to the neighboring processor
4912 nn=num_cont_hb(iatel_s+1)
4914 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4916 num_cont_hb(iatel_s)=0
4918 cd write (iout,*) 'Processor ',MyID,MyRank,
4919 cd & ' is sending correlation contribution to processor',MyID-1,
4920 cd & ' msglen=',msglen
4921 cd write (*,*) 'Processor ',MyID,MyRank,
4922 cd & ' is sending correlation contribution to processor',MyID-1,
4923 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4924 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4925 cd write (iout,*) 'Processor ',MyID,
4926 cd & ' has sent correlation contribution to processor',MyID-1,
4927 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4928 cd write (*,*) 'Processor ',MyID,
4929 cd & ' has sent correlation contribution to processor',MyID-1,
4930 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4932 endif ! (MyRank.gt.0)
4936 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4937 if (MyRank.lt.fgProcs-1) then
4938 C Receive correlation contributions from the next processor
4940 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4941 cd write (iout,*) 'Processor',MyID,
4942 cd & ' is receiving correlation contribution from processor',MyID+1,
4943 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4944 cd write (*,*) 'Processor',MyID,
4945 cd & ' is receiving correlation contribution from processor',MyID+1,
4946 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4948 do while (nbytes.le.0)
4949 call mp_probe(MyID+1,CorrelType,nbytes)
4951 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4952 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4953 cd write (iout,*) 'Processor',MyID,
4954 cd & ' has received correlation contribution from processor',MyID+1,
4955 cd & ' msglen=',msglen,' nbytes=',nbytes
4956 cd write (iout,*) 'The received BUFFER array:'
4958 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4960 if (msglen.eq.msglen1) then
4961 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4962 else if (msglen.eq.msglen2) then
4963 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4964 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4967 & 'ERROR!!!! message length changed while processing correlations.'
4969 & 'ERROR!!!! message length changed while processing correlations.'
4970 call mp_stopall(Error)
4971 endif ! msglen.eq.msglen1
4972 endif ! MyRank.lt.fgProcs-1
4979 write (iout,'(a)') 'Contact function values:'
4981 write (iout,'(2i3,50(1x,i2,f5.2))')
4982 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4983 & j=1,num_cont_hb(i))
4989 C Remove the loop below after debugging !!!
4996 C Calculate the dipole-dipole interaction energies
4997 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
4998 do i=iatel_s,iatel_e+1
4999 num_conti=num_cont_hb(i)
5006 C Calculate the local-electrostatic correlation terms
5007 do i=iatel_s,iatel_e+1
5009 num_conti=num_cont_hb(i)
5010 num_conti1=num_cont_hb(i+1)
5015 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5016 c & ' jj=',jj,' kk=',kk
5017 if (j1.eq.j+1 .or. j1.eq.j-1) then
5018 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5019 C The system gains extra energy.
5021 sqd1=dsqrt(d_cont(jj,i))
5022 sqd2=dsqrt(d_cont(kk,i1))
5023 sred_geom = sqd1*sqd2
5024 IF (sred_geom.lt.cutoff_corr) THEN
5025 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5027 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5028 c & ' jj=',jj,' kk=',kk
5029 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5030 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5032 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5033 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5036 cd write (iout,*) 'sred_geom=',sred_geom,
5037 cd & ' ekont=',ekont,' fprim=',fprimcont
5038 call calc_eello(i,j,i+1,j1,jj,kk)
5039 if (wcorr4.gt.0.0d0)
5040 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5041 if (wcorr5.gt.0.0d0)
5042 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5043 c print *,"wcorr5",ecorr5
5044 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5045 cd write(2,*)'ijkl',i,j,i+1,j1
5046 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5047 & .or. wturn6.eq.0.0d0))then
5048 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5049 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5050 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5051 cd & 'ecorr6=',ecorr6
5052 cd write (iout,'(4e15.5)') sred_geom,
5053 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5054 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5055 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5056 else if (wturn6.gt.0.0d0
5057 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5058 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5059 eturn6=eturn6+eello_turn6(i,jj,kk)
5060 cd write (2,*) 'multibody_eello:eturn6',eturn6
5064 else if (j1.eq.j) then
5065 C Contacts I-J and I-(J+1) occur simultaneously.
5066 C The system loses extra energy.
5067 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5072 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5073 c & ' jj=',jj,' kk=',kk
5075 C Contacts I-J and (I+1)-J occur simultaneously.
5076 C The system loses extra energy.
5077 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5084 c------------------------------------------------------------------------------
5085 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5086 implicit real*8 (a-h,o-z)
5087 include 'DIMENSIONS'
5088 include 'COMMON.IOUNITS'
5089 include 'COMMON.DERIV'
5090 include 'COMMON.INTERACT'
5091 include 'COMMON.CONTACTS'
5092 double precision gx(3),gx1(3)
5102 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5103 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5104 C Following 4 lines for diagnostics.
5109 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5111 c write (iout,*)'Contacts have occurred for peptide groups',
5112 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5113 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5114 C Calculate the multi-body contribution to energy.
5115 ecorr=ecorr+ekont*ees
5117 C Calculate multi-body contributions to the gradient.
5119 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5120 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5121 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5122 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5123 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5124 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5125 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5126 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5127 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5128 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5129 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5130 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5131 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5132 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5136 gradcorr(ll,m)=gradcorr(ll,m)+
5137 & ees*ekl*gacont_hbr(ll,jj,i)-
5138 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5139 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5144 gradcorr(ll,m)=gradcorr(ll,m)+
5145 & ees*eij*gacont_hbr(ll,kk,k)-
5146 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5147 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5154 C---------------------------------------------------------------------------
5155 subroutine dipole(i,j,jj)
5156 implicit real*8 (a-h,o-z)
5157 include 'DIMENSIONS'
5158 include 'sizesclu.dat'
5159 include 'COMMON.IOUNITS'
5160 include 'COMMON.CHAIN'
5161 include 'COMMON.FFIELD'
5162 include 'COMMON.DERIV'
5163 include 'COMMON.INTERACT'
5164 include 'COMMON.CONTACTS'
5165 include 'COMMON.TORSION'
5166 include 'COMMON.VAR'
5167 include 'COMMON.GEO'
5168 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5170 iti1 = itortyp(itype(i+1))
5171 if (j.lt.nres-1) then
5172 itj1 = itortyp(itype(j+1))
5177 dipi(iii,1)=Ub2(iii,i)
5178 dipderi(iii)=Ub2der(iii,i)
5179 dipi(iii,2)=b1(iii,iti1)
5180 dipj(iii,1)=Ub2(iii,j)
5181 dipderj(iii)=Ub2der(iii,j)
5182 dipj(iii,2)=b1(iii,itj1)
5186 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5189 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5192 if (.not.calc_grad) return
5197 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5201 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5206 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5207 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5209 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5211 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5213 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5217 C---------------------------------------------------------------------------
5218 subroutine calc_eello(i,j,k,l,jj,kk)
5220 C This subroutine computes matrices and vectors needed to calculate
5221 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5223 implicit real*8 (a-h,o-z)
5224 include 'DIMENSIONS'
5225 include 'sizesclu.dat'
5226 include 'COMMON.IOUNITS'
5227 include 'COMMON.CHAIN'
5228 include 'COMMON.DERIV'
5229 include 'COMMON.INTERACT'
5230 include 'COMMON.CONTACTS'
5231 include 'COMMON.TORSION'
5232 include 'COMMON.VAR'
5233 include 'COMMON.GEO'
5234 include 'COMMON.FFIELD'
5235 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5236 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5239 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5240 cd & ' jj=',jj,' kk=',kk
5241 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5244 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5245 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5248 call transpose2(aa1(1,1),aa1t(1,1))
5249 call transpose2(aa2(1,1),aa2t(1,1))
5252 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5253 & aa1tder(1,1,lll,kkk))
5254 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5255 & aa2tder(1,1,lll,kkk))
5259 C parallel orientation of the two CA-CA-CA frames.
5261 iti=itortyp(itype(i))
5265 itk1=itortyp(itype(k+1))
5266 itj=itortyp(itype(j))
5267 if (l.lt.nres-1) then
5268 itl1=itortyp(itype(l+1))
5272 C A1 kernel(j+1) A2T
5274 cd write (iout,'(3f10.5,5x,3f10.5)')
5275 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5277 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5278 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5279 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5280 C Following matrices are needed only for 6-th order cumulants
5281 IF (wcorr6.gt.0.0d0) THEN
5282 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5283 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5284 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5285 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5286 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5287 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5288 & ADtEAderx(1,1,1,1,1,1))
5290 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5291 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5292 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5293 & ADtEA1derx(1,1,1,1,1,1))
5295 C End 6-th order cumulants
5298 cd write (2,*) 'In calc_eello6'
5300 cd write (2,*) 'iii=',iii
5302 cd write (2,*) 'kkk=',kkk
5304 cd write (2,'(3(2f10.5),5x)')
5305 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5310 call transpose2(EUgder(1,1,k),auxmat(1,1))
5311 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5312 call transpose2(EUg(1,1,k),auxmat(1,1))
5313 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5314 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5318 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5319 & EAEAderx(1,1,lll,kkk,iii,1))
5323 C A1T kernel(i+1) A2
5324 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5325 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5326 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5327 C Following matrices are needed only for 6-th order cumulants
5328 IF (wcorr6.gt.0.0d0) THEN
5329 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5330 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5331 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5332 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5333 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5334 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5335 & ADtEAderx(1,1,1,1,1,2))
5336 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5337 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5338 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5339 & ADtEA1derx(1,1,1,1,1,2))
5341 C End 6-th order cumulants
5342 call transpose2(EUgder(1,1,l),auxmat(1,1))
5343 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5344 call transpose2(EUg(1,1,l),auxmat(1,1))
5345 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5346 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5350 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5351 & EAEAderx(1,1,lll,kkk,iii,2))
5356 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5357 C They are needed only when the fifth- or the sixth-order cumulants are
5359 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5360 call transpose2(AEA(1,1,1),auxmat(1,1))
5361 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5362 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5363 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5364 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5365 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5366 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5367 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5368 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5369 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5370 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5371 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5372 call transpose2(AEA(1,1,2),auxmat(1,1))
5373 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5374 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5375 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5376 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5377 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5378 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5379 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5380 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5381 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5382 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5383 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5384 C Calculate the Cartesian derivatives of the vectors.
5388 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5389 call matvec2(auxmat(1,1),b1(1,iti),
5390 & AEAb1derx(1,lll,kkk,iii,1,1))
5391 call matvec2(auxmat(1,1),Ub2(1,i),
5392 & AEAb2derx(1,lll,kkk,iii,1,1))
5393 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5394 & AEAb1derx(1,lll,kkk,iii,2,1))
5395 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5396 & AEAb2derx(1,lll,kkk,iii,2,1))
5397 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5398 call matvec2(auxmat(1,1),b1(1,itj),
5399 & AEAb1derx(1,lll,kkk,iii,1,2))
5400 call matvec2(auxmat(1,1),Ub2(1,j),
5401 & AEAb2derx(1,lll,kkk,iii,1,2))
5402 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5403 & AEAb1derx(1,lll,kkk,iii,2,2))
5404 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5405 & AEAb2derx(1,lll,kkk,iii,2,2))
5412 C Antiparallel orientation of the two CA-CA-CA frames.
5414 iti=itortyp(itype(i))
5418 itk1=itortyp(itype(k+1))
5419 itl=itortyp(itype(l))
5420 itj=itortyp(itype(j))
5421 if (j.lt.nres-1) then
5422 itj1=itortyp(itype(j+1))
5426 C A2 kernel(j-1)T A1T
5427 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5428 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5429 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5430 C Following matrices are needed only for 6-th order cumulants
5431 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5432 & j.eq.i+4 .and. l.eq.i+3)) THEN
5433 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5434 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5435 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5436 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5437 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5438 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5439 & ADtEAderx(1,1,1,1,1,1))
5440 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5441 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5442 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5443 & ADtEA1derx(1,1,1,1,1,1))
5445 C End 6-th order cumulants
5446 call transpose2(EUgder(1,1,k),auxmat(1,1))
5447 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5448 call transpose2(EUg(1,1,k),auxmat(1,1))
5449 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5450 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5454 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5455 & EAEAderx(1,1,lll,kkk,iii,1))
5459 C A2T kernel(i+1)T A1
5460 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5461 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5462 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5463 C Following matrices are needed only for 6-th order cumulants
5464 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5465 & j.eq.i+4 .and. l.eq.i+3)) THEN
5466 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5467 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5468 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5469 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5470 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5471 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5472 & ADtEAderx(1,1,1,1,1,2))
5473 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5474 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5475 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5476 & ADtEA1derx(1,1,1,1,1,2))
5478 C End 6-th order cumulants
5479 call transpose2(EUgder(1,1,j),auxmat(1,1))
5480 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5481 call transpose2(EUg(1,1,j),auxmat(1,1))
5482 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5483 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5487 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5488 & EAEAderx(1,1,lll,kkk,iii,2))
5493 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5494 C They are needed only when the fifth- or the sixth-order cumulants are
5496 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5497 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5498 call transpose2(AEA(1,1,1),auxmat(1,1))
5499 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5500 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5501 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5502 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5503 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5504 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5505 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5506 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5507 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5508 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5509 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5510 call transpose2(AEA(1,1,2),auxmat(1,1))
5511 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5512 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5513 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5514 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5515 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5516 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5517 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5518 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5519 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5520 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5521 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5522 C Calculate the Cartesian derivatives of the vectors.
5526 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5527 call matvec2(auxmat(1,1),b1(1,iti),
5528 & AEAb1derx(1,lll,kkk,iii,1,1))
5529 call matvec2(auxmat(1,1),Ub2(1,i),
5530 & AEAb2derx(1,lll,kkk,iii,1,1))
5531 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5532 & AEAb1derx(1,lll,kkk,iii,2,1))
5533 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5534 & AEAb2derx(1,lll,kkk,iii,2,1))
5535 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5536 call matvec2(auxmat(1,1),b1(1,itl),
5537 & AEAb1derx(1,lll,kkk,iii,1,2))
5538 call matvec2(auxmat(1,1),Ub2(1,l),
5539 & AEAb2derx(1,lll,kkk,iii,1,2))
5540 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5541 & AEAb1derx(1,lll,kkk,iii,2,2))
5542 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5543 & AEAb2derx(1,lll,kkk,iii,2,2))
5552 C---------------------------------------------------------------------------
5553 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5554 & KK,KKderg,AKA,AKAderg,AKAderx)
5558 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5559 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5560 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5565 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5567 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5570 cd if (lprn) write (2,*) 'In kernel'
5572 cd if (lprn) write (2,*) 'kkk=',kkk
5574 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5575 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5577 cd write (2,*) 'lll=',lll
5578 cd write (2,*) 'iii=1'
5580 cd write (2,'(3(2f10.5),5x)')
5581 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5584 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5585 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5587 cd write (2,*) 'lll=',lll
5588 cd write (2,*) 'iii=2'
5590 cd write (2,'(3(2f10.5),5x)')
5591 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5598 C---------------------------------------------------------------------------
5599 double precision function eello4(i,j,k,l,jj,kk)
5600 implicit real*8 (a-h,o-z)
5601 include 'DIMENSIONS'
5602 include 'sizesclu.dat'
5603 include 'COMMON.IOUNITS'
5604 include 'COMMON.CHAIN'
5605 include 'COMMON.DERIV'
5606 include 'COMMON.INTERACT'
5607 include 'COMMON.CONTACTS'
5608 include 'COMMON.TORSION'
5609 include 'COMMON.VAR'
5610 include 'COMMON.GEO'
5611 double precision pizda(2,2),ggg1(3),ggg2(3)
5612 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5616 cd print *,'eello4:',i,j,k,l,jj,kk
5617 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5618 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5619 cold eij=facont_hb(jj,i)
5620 cold ekl=facont_hb(kk,k)
5622 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5624 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5625 gcorr_loc(k-1)=gcorr_loc(k-1)
5626 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5628 gcorr_loc(l-1)=gcorr_loc(l-1)
5629 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5631 gcorr_loc(j-1)=gcorr_loc(j-1)
5632 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5637 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5638 & -EAEAderx(2,2,lll,kkk,iii,1)
5639 cd derx(lll,kkk,iii)=0.0d0
5643 cd gcorr_loc(l-1)=0.0d0
5644 cd gcorr_loc(j-1)=0.0d0
5645 cd gcorr_loc(k-1)=0.0d0
5647 cd write (iout,*)'Contacts have occurred for peptide groups',
5648 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5649 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5650 if (j.lt.nres-1) then
5657 if (l.lt.nres-1) then
5665 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5666 ggg1(ll)=eel4*g_contij(ll,1)
5667 ggg2(ll)=eel4*g_contij(ll,2)
5668 ghalf=0.5d0*ggg1(ll)
5670 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5671 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5672 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5673 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5674 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5675 ghalf=0.5d0*ggg2(ll)
5677 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5678 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5679 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5680 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5685 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5686 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5691 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5692 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5698 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5703 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5707 cd write (2,*) iii,gcorr_loc(iii)
5711 cd write (2,*) 'ekont',ekont
5712 cd write (iout,*) 'eello4',ekont*eel4
5715 C---------------------------------------------------------------------------
5716 double precision function eello5(i,j,k,l,jj,kk)
5717 implicit real*8 (a-h,o-z)
5718 include 'DIMENSIONS'
5719 include 'sizesclu.dat'
5720 include 'COMMON.IOUNITS'
5721 include 'COMMON.CHAIN'
5722 include 'COMMON.DERIV'
5723 include 'COMMON.INTERACT'
5724 include 'COMMON.CONTACTS'
5725 include 'COMMON.TORSION'
5726 include 'COMMON.VAR'
5727 include 'COMMON.GEO'
5728 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5729 double precision ggg1(3),ggg2(3)
5730 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5735 C /l\ / \ \ / \ / \ / C
5736 C / \ / \ \ / \ / \ / C
5737 C j| o |l1 | o | o| o | | o |o C
5738 C \ |/k\| |/ \| / |/ \| |/ \| C
5739 C \i/ \ / \ / / \ / \ C
5741 C (I) (II) (III) (IV) C
5743 C eello5_1 eello5_2 eello5_3 eello5_4 C
5745 C Antiparallel chains C
5748 C /j\ / \ \ / \ / \ / C
5749 C / \ / \ \ / \ / \ / C
5750 C j1| o |l | o | o| o | | o |o C
5751 C \ |/k\| |/ \| / |/ \| |/ \| C
5752 C \i/ \ / \ / / \ / \ C
5754 C (I) (II) (III) (IV) C
5756 C eello5_1 eello5_2 eello5_3 eello5_4 C
5758 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5760 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5761 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5766 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5768 itk=itortyp(itype(k))
5769 itl=itortyp(itype(l))
5770 itj=itortyp(itype(j))
5775 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5776 cd & eel5_3_num,eel5_4_num)
5780 derx(lll,kkk,iii)=0.0d0
5784 cd eij=facont_hb(jj,i)
5785 cd ekl=facont_hb(kk,k)
5787 cd write (iout,*)'Contacts have occurred for peptide groups',
5788 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5790 C Contribution from the graph I.
5791 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5792 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5793 call transpose2(EUg(1,1,k),auxmat(1,1))
5794 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5795 vv(1)=pizda(1,1)-pizda(2,2)
5796 vv(2)=pizda(1,2)+pizda(2,1)
5797 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5798 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5800 C Explicit gradient in virtual-dihedral angles.
5801 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5802 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5803 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5804 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5805 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5806 vv(1)=pizda(1,1)-pizda(2,2)
5807 vv(2)=pizda(1,2)+pizda(2,1)
5808 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5809 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5810 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5811 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5812 vv(1)=pizda(1,1)-pizda(2,2)
5813 vv(2)=pizda(1,2)+pizda(2,1)
5815 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5816 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5817 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5819 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5820 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5821 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5823 C Cartesian gradient
5827 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5829 vv(1)=pizda(1,1)-pizda(2,2)
5830 vv(2)=pizda(1,2)+pizda(2,1)
5831 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5832 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5833 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5840 C Contribution from graph II
5841 call transpose2(EE(1,1,itk),auxmat(1,1))
5842 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5843 vv(1)=pizda(1,1)+pizda(2,2)
5844 vv(2)=pizda(2,1)-pizda(1,2)
5845 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5846 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5848 C Explicit gradient in virtual-dihedral angles.
5849 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5850 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5851 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5852 vv(1)=pizda(1,1)+pizda(2,2)
5853 vv(2)=pizda(2,1)-pizda(1,2)
5855 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5856 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5857 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5859 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5860 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5861 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5863 C Cartesian gradient
5867 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5869 vv(1)=pizda(1,1)+pizda(2,2)
5870 vv(2)=pizda(2,1)-pizda(1,2)
5871 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5872 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5873 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5882 C Parallel orientation
5883 C Contribution from graph III
5884 call transpose2(EUg(1,1,l),auxmat(1,1))
5885 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5886 vv(1)=pizda(1,1)-pizda(2,2)
5887 vv(2)=pizda(1,2)+pizda(2,1)
5888 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5889 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5891 C Explicit gradient in virtual-dihedral angles.
5892 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5893 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5894 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5895 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5896 vv(1)=pizda(1,1)-pizda(2,2)
5897 vv(2)=pizda(1,2)+pizda(2,1)
5898 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5899 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5900 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5901 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5902 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5903 vv(1)=pizda(1,1)-pizda(2,2)
5904 vv(2)=pizda(1,2)+pizda(2,1)
5905 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5906 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5907 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5908 C Cartesian gradient
5912 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5914 vv(1)=pizda(1,1)-pizda(2,2)
5915 vv(2)=pizda(1,2)+pizda(2,1)
5916 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5917 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5918 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5924 C Contribution from graph IV
5926 call transpose2(EE(1,1,itl),auxmat(1,1))
5927 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5928 vv(1)=pizda(1,1)+pizda(2,2)
5929 vv(2)=pizda(2,1)-pizda(1,2)
5930 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5931 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5933 C Explicit gradient in virtual-dihedral angles.
5934 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5935 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5936 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5937 vv(1)=pizda(1,1)+pizda(2,2)
5938 vv(2)=pizda(2,1)-pizda(1,2)
5939 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5940 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5941 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5942 C Cartesian gradient
5946 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5948 vv(1)=pizda(1,1)+pizda(2,2)
5949 vv(2)=pizda(2,1)-pizda(1,2)
5950 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5951 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5952 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5958 C Antiparallel orientation
5959 C Contribution from graph III
5961 call transpose2(EUg(1,1,j),auxmat(1,1))
5962 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5963 vv(1)=pizda(1,1)-pizda(2,2)
5964 vv(2)=pizda(1,2)+pizda(2,1)
5965 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
5966 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5968 C Explicit gradient in virtual-dihedral angles.
5969 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5970 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
5971 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
5972 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5973 vv(1)=pizda(1,1)-pizda(2,2)
5974 vv(2)=pizda(1,2)+pizda(2,1)
5975 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5976 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
5977 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
5978 call transpose2(EUgder(1,1,j),auxmat1(1,1))
5979 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5980 vv(1)=pizda(1,1)-pizda(2,2)
5981 vv(2)=pizda(1,2)+pizda(2,1)
5982 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5983 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
5984 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
5985 C Cartesian gradient
5989 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5991 vv(1)=pizda(1,1)-pizda(2,2)
5992 vv(2)=pizda(1,2)+pizda(2,1)
5993 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
5994 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
5995 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6001 C Contribution from graph IV
6003 call transpose2(EE(1,1,itj),auxmat(1,1))
6004 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6005 vv(1)=pizda(1,1)+pizda(2,2)
6006 vv(2)=pizda(2,1)-pizda(1,2)
6007 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6008 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6010 C Explicit gradient in virtual-dihedral angles.
6011 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6012 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6013 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6014 vv(1)=pizda(1,1)+pizda(2,2)
6015 vv(2)=pizda(2,1)-pizda(1,2)
6016 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6017 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6018 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6019 C Cartesian gradient
6023 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6025 vv(1)=pizda(1,1)+pizda(2,2)
6026 vv(2)=pizda(2,1)-pizda(1,2)
6027 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6028 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6029 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6036 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6037 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6038 cd write (2,*) 'ijkl',i,j,k,l
6039 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6040 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6042 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6043 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6044 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6045 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6047 if (j.lt.nres-1) then
6054 if (l.lt.nres-1) then
6064 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6066 ggg1(ll)=eel5*g_contij(ll,1)
6067 ggg2(ll)=eel5*g_contij(ll,2)
6068 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6069 ghalf=0.5d0*ggg1(ll)
6071 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6072 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6073 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6074 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6075 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6076 ghalf=0.5d0*ggg2(ll)
6078 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6079 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6080 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6081 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6086 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6087 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6092 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6093 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6099 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6104 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6108 cd write (2,*) iii,g_corr5_loc(iii)
6112 cd write (2,*) 'ekont',ekont
6113 cd write (iout,*) 'eello5',ekont*eel5
6116 c--------------------------------------------------------------------------
6117 double precision function eello6(i,j,k,l,jj,kk)
6118 implicit real*8 (a-h,o-z)
6119 include 'DIMENSIONS'
6120 include 'sizesclu.dat'
6121 include 'COMMON.IOUNITS'
6122 include 'COMMON.CHAIN'
6123 include 'COMMON.DERIV'
6124 include 'COMMON.INTERACT'
6125 include 'COMMON.CONTACTS'
6126 include 'COMMON.TORSION'
6127 include 'COMMON.VAR'
6128 include 'COMMON.GEO'
6129 include 'COMMON.FFIELD'
6130 double precision ggg1(3),ggg2(3)
6131 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6136 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6144 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6145 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6149 derx(lll,kkk,iii)=0.0d0
6153 cd eij=facont_hb(jj,i)
6154 cd ekl=facont_hb(kk,k)
6160 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6161 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6162 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6163 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6164 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6165 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6167 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6168 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6169 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6170 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6171 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6172 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6176 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6178 C If turn contributions are considered, they will be handled separately.
6179 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6180 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6181 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6182 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6183 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6184 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6185 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6188 if (j.lt.nres-1) then
6195 if (l.lt.nres-1) then
6203 ggg1(ll)=eel6*g_contij(ll,1)
6204 ggg2(ll)=eel6*g_contij(ll,2)
6205 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6206 ghalf=0.5d0*ggg1(ll)
6208 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6209 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6210 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6211 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6212 ghalf=0.5d0*ggg2(ll)
6213 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6215 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6216 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6217 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6218 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6223 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6224 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6229 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6230 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6236 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6241 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6245 cd write (2,*) iii,g_corr6_loc(iii)
6249 cd write (2,*) 'ekont',ekont
6250 cd write (iout,*) 'eello6',ekont*eel6
6253 c--------------------------------------------------------------------------
6254 double precision function eello6_graph1(i,j,k,l,imat,swap)
6255 implicit real*8 (a-h,o-z)
6256 include 'DIMENSIONS'
6257 include 'sizesclu.dat'
6258 include 'COMMON.IOUNITS'
6259 include 'COMMON.CHAIN'
6260 include 'COMMON.DERIV'
6261 include 'COMMON.INTERACT'
6262 include 'COMMON.CONTACTS'
6263 include 'COMMON.TORSION'
6264 include 'COMMON.VAR'
6265 include 'COMMON.GEO'
6266 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6270 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6272 C Parallel Antiparallel C
6278 C \ j|/k\| / \ |/k\|l / C
6283 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6284 itk=itortyp(itype(k))
6285 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6286 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6287 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6288 call transpose2(EUgC(1,1,k),auxmat(1,1))
6289 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6290 vv1(1)=pizda1(1,1)-pizda1(2,2)
6291 vv1(2)=pizda1(1,2)+pizda1(2,1)
6292 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6293 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6294 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6295 s5=scalar2(vv(1),Dtobr2(1,i))
6296 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6297 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6298 if (.not. calc_grad) return
6299 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6300 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6301 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6302 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6303 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6304 & +scalar2(vv(1),Dtobr2der(1,i)))
6305 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6306 vv1(1)=pizda1(1,1)-pizda1(2,2)
6307 vv1(2)=pizda1(1,2)+pizda1(2,1)
6308 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6309 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6311 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6312 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6313 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6314 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6315 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6317 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6318 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6319 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6320 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6321 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6323 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6324 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6325 vv1(1)=pizda1(1,1)-pizda1(2,2)
6326 vv1(2)=pizda1(1,2)+pizda1(2,1)
6327 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6328 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6329 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6330 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6339 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6340 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6341 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6342 call transpose2(EUgC(1,1,k),auxmat(1,1))
6343 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6345 vv1(1)=pizda1(1,1)-pizda1(2,2)
6346 vv1(2)=pizda1(1,2)+pizda1(2,1)
6347 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6348 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6349 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6350 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6351 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6352 s5=scalar2(vv(1),Dtobr2(1,i))
6353 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6359 c----------------------------------------------------------------------------
6360 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6361 implicit real*8 (a-h,o-z)
6362 include 'DIMENSIONS'
6363 include 'sizesclu.dat'
6364 include 'COMMON.IOUNITS'
6365 include 'COMMON.CHAIN'
6366 include 'COMMON.DERIV'
6367 include 'COMMON.INTERACT'
6368 include 'COMMON.CONTACTS'
6369 include 'COMMON.TORSION'
6370 include 'COMMON.VAR'
6371 include 'COMMON.GEO'
6373 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6374 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6377 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6379 C Parallel Antiparallel C
6385 C \ j|/k\| \ |/k\|l C
6390 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6391 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6392 C AL 7/4/01 s1 would occur in the sixth-order moment,
6393 C but not in a cluster cumulant
6395 s1=dip(1,jj,i)*dip(1,kk,k)
6397 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6398 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6399 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6400 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6401 call transpose2(EUg(1,1,k),auxmat(1,1))
6402 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6403 vv(1)=pizda(1,1)-pizda(2,2)
6404 vv(2)=pizda(1,2)+pizda(2,1)
6405 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6406 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6408 eello6_graph2=-(s1+s2+s3+s4)
6410 eello6_graph2=-(s2+s3+s4)
6413 if (.not. calc_grad) return
6414 C Derivatives in gamma(i-1)
6417 s1=dipderg(1,jj,i)*dip(1,kk,k)
6419 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6420 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6421 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6422 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6424 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6426 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6428 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6430 C Derivatives in gamma(k-1)
6432 s1=dip(1,jj,i)*dipderg(1,kk,k)
6434 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6435 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6436 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6437 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6438 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6439 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6440 vv(1)=pizda(1,1)-pizda(2,2)
6441 vv(2)=pizda(1,2)+pizda(2,1)
6442 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6444 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6446 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6448 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6449 C Derivatives in gamma(j-1) or gamma(l-1)
6452 s1=dipderg(3,jj,i)*dip(1,kk,k)
6454 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6455 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6456 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6457 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6458 vv(1)=pizda(1,1)-pizda(2,2)
6459 vv(2)=pizda(1,2)+pizda(2,1)
6460 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6463 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6465 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6468 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6469 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6471 C Derivatives in gamma(l-1) or gamma(j-1)
6474 s1=dip(1,jj,i)*dipderg(3,kk,k)
6476 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6477 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6478 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6479 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6480 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6481 vv(1)=pizda(1,1)-pizda(2,2)
6482 vv(2)=pizda(1,2)+pizda(2,1)
6483 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6486 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6488 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6491 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6492 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6494 C Cartesian derivatives.
6496 write (2,*) 'In eello6_graph2'
6498 write (2,*) 'iii=',iii
6500 write (2,*) 'kkk=',kkk
6502 write (2,'(3(2f10.5),5x)')
6503 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6513 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6515 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6518 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6520 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6521 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6523 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6524 call transpose2(EUg(1,1,k),auxmat(1,1))
6525 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6527 vv(1)=pizda(1,1)-pizda(2,2)
6528 vv(2)=pizda(1,2)+pizda(2,1)
6529 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6530 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6532 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6534 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6537 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6539 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6546 c----------------------------------------------------------------------------
6547 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6548 implicit real*8 (a-h,o-z)
6549 include 'DIMENSIONS'
6550 include 'sizesclu.dat'
6551 include 'COMMON.IOUNITS'
6552 include 'COMMON.CHAIN'
6553 include 'COMMON.DERIV'
6554 include 'COMMON.INTERACT'
6555 include 'COMMON.CONTACTS'
6556 include 'COMMON.TORSION'
6557 include 'COMMON.VAR'
6558 include 'COMMON.GEO'
6559 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6561 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6563 C Parallel Antiparallel C
6569 C j|/k\| / |/k\|l / C
6574 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6576 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6577 C energy moment and not to the cluster cumulant.
6578 iti=itortyp(itype(i))
6579 if (j.lt.nres-1) then
6580 itj1=itortyp(itype(j+1))
6584 itk=itortyp(itype(k))
6585 itk1=itortyp(itype(k+1))
6586 if (l.lt.nres-1) then
6587 itl1=itortyp(itype(l+1))
6592 s1=dip(4,jj,i)*dip(4,kk,k)
6594 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6595 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6596 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6597 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6598 call transpose2(EE(1,1,itk),auxmat(1,1))
6599 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6600 vv(1)=pizda(1,1)+pizda(2,2)
6601 vv(2)=pizda(2,1)-pizda(1,2)
6602 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6603 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6605 eello6_graph3=-(s1+s2+s3+s4)
6607 eello6_graph3=-(s2+s3+s4)
6610 if (.not. calc_grad) return
6611 C Derivatives in gamma(k-1)
6612 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6613 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6614 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6615 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6616 C Derivatives in gamma(l-1)
6617 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6618 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6619 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6620 vv(1)=pizda(1,1)+pizda(2,2)
6621 vv(2)=pizda(2,1)-pizda(1,2)
6622 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6623 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6624 C Cartesian derivatives.
6630 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6632 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6635 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6637 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6638 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6640 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6641 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6643 vv(1)=pizda(1,1)+pizda(2,2)
6644 vv(2)=pizda(2,1)-pizda(1,2)
6645 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6647 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6649 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6652 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6654 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6656 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6662 c----------------------------------------------------------------------------
6663 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6664 implicit real*8 (a-h,o-z)
6665 include 'DIMENSIONS'
6666 include 'sizesclu.dat'
6667 include 'COMMON.IOUNITS'
6668 include 'COMMON.CHAIN'
6669 include 'COMMON.DERIV'
6670 include 'COMMON.INTERACT'
6671 include 'COMMON.CONTACTS'
6672 include 'COMMON.TORSION'
6673 include 'COMMON.VAR'
6674 include 'COMMON.GEO'
6675 include 'COMMON.FFIELD'
6676 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6677 & auxvec1(2),auxmat1(2,2)
6679 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6681 C Parallel Antiparallel C
6687 C \ j|/k\| \ |/k\|l C
6692 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6694 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6695 C energy moment and not to the cluster cumulant.
6696 cd write (2,*) 'eello_graph4: wturn6',wturn6
6697 iti=itortyp(itype(i))
6698 itj=itortyp(itype(j))
6699 if (j.lt.nres-1) then
6700 itj1=itortyp(itype(j+1))
6704 itk=itortyp(itype(k))
6705 if (k.lt.nres-1) then
6706 itk1=itortyp(itype(k+1))
6710 itl=itortyp(itype(l))
6711 if (l.lt.nres-1) then
6712 itl1=itortyp(itype(l+1))
6716 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6717 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6718 cd & ' itl',itl,' itl1',itl1
6721 s1=dip(3,jj,i)*dip(3,kk,k)
6723 s1=dip(2,jj,j)*dip(2,kk,l)
6726 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6727 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6729 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6730 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6732 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6733 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6735 call transpose2(EUg(1,1,k),auxmat(1,1))
6736 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6737 vv(1)=pizda(1,1)-pizda(2,2)
6738 vv(2)=pizda(2,1)+pizda(1,2)
6739 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6740 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6742 eello6_graph4=-(s1+s2+s3+s4)
6744 eello6_graph4=-(s2+s3+s4)
6746 if (.not. calc_grad) return
6747 C Derivatives in gamma(i-1)
6751 s1=dipderg(2,jj,i)*dip(3,kk,k)
6753 s1=dipderg(4,jj,j)*dip(2,kk,l)
6756 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6758 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6759 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6761 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6762 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6764 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6765 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6766 cd write (2,*) 'turn6 derivatives'
6768 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6770 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6774 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6776 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6780 C Derivatives in gamma(k-1)
6783 s1=dip(3,jj,i)*dipderg(2,kk,k)
6785 s1=dip(2,jj,j)*dipderg(4,kk,l)
6788 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6789 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6791 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6792 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6794 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6795 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6797 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6798 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6799 vv(1)=pizda(1,1)-pizda(2,2)
6800 vv(2)=pizda(2,1)+pizda(1,2)
6801 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6802 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6804 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6806 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6810 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6812 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6815 C Derivatives in gamma(j-1) or gamma(l-1)
6816 if (l.eq.j+1 .and. l.gt.1) then
6817 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6818 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6819 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6820 vv(1)=pizda(1,1)-pizda(2,2)
6821 vv(2)=pizda(2,1)+pizda(1,2)
6822 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6823 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6824 else if (j.gt.1) then
6825 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6826 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6827 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6828 vv(1)=pizda(1,1)-pizda(2,2)
6829 vv(2)=pizda(2,1)+pizda(1,2)
6830 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6831 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6832 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6834 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6837 C Cartesian derivatives.
6844 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6846 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6850 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6852 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6856 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6858 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6860 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6861 & b1(1,itj1),auxvec(1))
6862 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6864 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6865 & b1(1,itl1),auxvec(1))
6866 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6868 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6870 vv(1)=pizda(1,1)-pizda(2,2)
6871 vv(2)=pizda(2,1)+pizda(1,2)
6872 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6874 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6876 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6879 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6882 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6885 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6887 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6889 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6893 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6895 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6898 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6900 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6908 c----------------------------------------------------------------------------
6909 double precision function eello_turn6(i,jj,kk)
6910 implicit real*8 (a-h,o-z)
6911 include 'DIMENSIONS'
6912 include 'sizesclu.dat'
6913 include 'COMMON.IOUNITS'
6914 include 'COMMON.CHAIN'
6915 include 'COMMON.DERIV'
6916 include 'COMMON.INTERACT'
6917 include 'COMMON.CONTACTS'
6918 include 'COMMON.TORSION'
6919 include 'COMMON.VAR'
6920 include 'COMMON.GEO'
6921 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6922 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6924 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6925 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6926 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6927 C the respective energy moment and not to the cluster cumulant.
6932 iti=itortyp(itype(i))
6933 itk=itortyp(itype(k))
6934 itk1=itortyp(itype(k+1))
6935 itl=itortyp(itype(l))
6936 itj=itortyp(itype(j))
6937 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6938 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6939 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6944 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6946 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6950 derx_turn(lll,kkk,iii)=0.0d0
6957 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6959 cd write (2,*) 'eello6_5',eello6_5
6961 call transpose2(AEA(1,1,1),auxmat(1,1))
6962 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
6963 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
6964 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
6968 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
6969 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
6970 s2 = scalar2(b1(1,itk),vtemp1(1))
6972 call transpose2(AEA(1,1,2),atemp(1,1))
6973 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
6974 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
6975 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
6979 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
6980 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
6981 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
6983 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
6984 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
6985 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
6986 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
6987 ss13 = scalar2(b1(1,itk),vtemp4(1))
6988 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
6992 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
6998 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7000 C Derivatives in gamma(i+2)
7002 call transpose2(AEA(1,1,1),auxmatd(1,1))
7003 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7004 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7005 call transpose2(AEAderg(1,1,2),atempd(1,1))
7006 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7007 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7011 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7012 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7013 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7019 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7020 C Derivatives in gamma(i+3)
7022 call transpose2(AEA(1,1,1),auxmatd(1,1))
7023 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7024 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7025 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7029 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7030 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7031 s2d = scalar2(b1(1,itk),vtemp1d(1))
7033 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7034 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7036 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7038 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7039 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7040 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7050 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7051 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7053 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7054 & -0.5d0*ekont*(s2d+s12d)
7056 C Derivatives in gamma(i+4)
7057 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7058 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7059 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7061 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7062 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7063 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7073 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7075 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7077 C Derivatives in gamma(i+5)
7079 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7080 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7081 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7085 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7086 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7087 s2d = scalar2(b1(1,itk),vtemp1d(1))
7089 call transpose2(AEA(1,1,2),atempd(1,1))
7090 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7091 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7095 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7096 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7098 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7099 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7100 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7110 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7111 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7113 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7114 & -0.5d0*ekont*(s2d+s12d)
7116 C Cartesian derivatives
7121 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7122 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7123 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7127 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7128 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7130 s2d = scalar2(b1(1,itk),vtemp1d(1))
7132 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7133 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7134 s8d = -(atempd(1,1)+atempd(2,2))*
7135 & scalar2(cc(1,1,itl),vtemp2(1))
7139 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7141 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7142 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7149 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7152 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7156 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7157 & - 0.5d0*(s8d+s12d)
7159 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7168 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7170 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7171 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7172 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7173 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7174 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7176 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7177 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7178 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7182 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7183 cd & 16*eel_turn6_num
7185 if (j.lt.nres-1) then
7192 if (l.lt.nres-1) then
7200 ggg1(ll)=eel_turn6*g_contij(ll,1)
7201 ggg2(ll)=eel_turn6*g_contij(ll,2)
7202 ghalf=0.5d0*ggg1(ll)
7204 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7205 & +ekont*derx_turn(ll,2,1)
7206 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7207 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7208 & +ekont*derx_turn(ll,4,1)
7209 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7210 ghalf=0.5d0*ggg2(ll)
7212 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7213 & +ekont*derx_turn(ll,2,2)
7214 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7215 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7216 & +ekont*derx_turn(ll,4,2)
7217 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7222 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7227 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7233 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7238 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7242 cd write (2,*) iii,g_corr6_loc(iii)
7245 eello_turn6=ekont*eel_turn6
7246 cd write (2,*) 'ekont',ekont
7247 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7250 crc-------------------------------------------------
7251 SUBROUTINE MATVEC2(A1,V1,V2)
7252 implicit real*8 (a-h,o-z)
7253 include 'DIMENSIONS'
7254 DIMENSION A1(2,2),V1(2),V2(2)
7258 c 3 VI=VI+A1(I,K)*V1(K)
7262 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7263 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7268 C---------------------------------------
7269 SUBROUTINE MATMAT2(A1,A2,A3)
7270 implicit real*8 (a-h,o-z)
7271 include 'DIMENSIONS'
7272 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7273 c DIMENSION AI3(2,2)
7277 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7283 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7284 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7285 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7286 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7294 c-------------------------------------------------------------------------
7295 double precision function scalar2(u,v)
7297 double precision u(2),v(2)
7300 scalar2=u(1)*v(1)+u(2)*v(2)
7304 C-----------------------------------------------------------------------------
7306 subroutine transpose2(a,at)
7308 double precision a(2,2),at(2,2)
7315 c--------------------------------------------------------------------------
7316 subroutine transpose(n,a,at)
7319 double precision a(n,n),at(n,n)
7327 C---------------------------------------------------------------------------
7328 subroutine prodmat3(a1,a2,kk,transp,prod)
7331 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7333 crc double precision auxmat(2,2),prod_(2,2)
7336 crc call transpose2(kk(1,1),auxmat(1,1))
7337 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7338 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7340 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7341 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7342 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7343 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7344 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7345 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7346 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7347 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7350 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7351 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7353 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7354 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7355 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7356 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7357 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7358 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7359 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7360 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7363 c call transpose2(a2(1,1),a2t(1,1))
7366 crc print *,((prod_(i,j),i=1,2),j=1,2)
7367 crc print *,((prod(i,j),i=1,2),j=1,2)
7371 C-----------------------------------------------------------------------------
7372 double precision function scalar(u,v)
7374 double precision u(3),v(3)