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'
2803 include 'COMMON.NAMES'
2806 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2807 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2810 write (iout,'(a4,2x,i4,3f10.5,5x,3f10.5)') restyp(itype(i)),i,
2811 & (c(j,i),j=1,3),(c(j,i+nres),j=1,3)
2814 if (link_end.eq.0) return
2815 do i=link_start,link_end
2816 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2817 C CA-CA distance used in regularization of structure.
2820 C iii and jjj point to the residues for which the distance is assigned.
2821 if (ii.gt.nres) then
2829 write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2830 & dhpb(i),dhpb1(i),forcon(i)
2832 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2833 C distance and angle dependent SS bond potential.
2834 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2835 call ssbond_ene(iii,jjj,eij)
2837 cd write (iout,*) "eij",eij
2838 else if (ii.gt.nres .and. jj.gt.nres) then
2839 c Restraints from contact prediction
2841 if (dhpb1(i).gt.0.0d0) then
2842 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2843 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2845 write (iout,*) "beta nmr",
2846 & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2851 C Get the force constant corresponding to this distance.
2853 C Calculate the contribution to energy.
2854 ehpb=ehpb+waga*rdis*rdis
2856 write (iout,*) "beta reg",dd,waga*rdis*rdis
2859 C Evaluate gradient.
2864 ggg(j)=fac*(c(j,jj)-c(j,ii))
2867 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2868 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2871 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2872 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2875 C Calculate the distance between the two points and its difference from the
2878 if (dhpb1(i).gt.0.0d0) then
2879 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2880 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2882 write (iout,*) "alph nmr",
2883 & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2887 C Get the force constant corresponding to this distance.
2889 C Calculate the contribution to energy.
2890 ehpb=ehpb+waga*rdis*rdis
2892 write (iout,*) "alpha reg",dd,waga*rdis*rdis
2895 C Evaluate gradient.
2899 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2900 cd & ' waga=',waga,' fac=',fac
2902 ggg(j)=fac*(c(j,jj)-c(j,ii))
2904 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2905 C If this is a SC-SC distance, we need to calculate the contributions to the
2906 C Cartesian gradient in the SC vectors (ghpbx).
2909 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2910 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2914 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2915 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2922 C--------------------------------------------------------------------------
2923 subroutine ssbond_ene(i,j,eij)
2925 C Calculate the distance and angle dependent SS-bond potential energy
2926 C using a free-energy function derived based on RHF/6-31G** ab initio
2927 C calculations of diethyl disulfide.
2929 C A. Liwo and U. Kozlowska, 11/24/03
2931 implicit real*8 (a-h,o-z)
2932 include 'DIMENSIONS'
2933 include 'sizesclu.dat'
2934 include 'COMMON.SBRIDGE'
2935 include 'COMMON.CHAIN'
2936 include 'COMMON.DERIV'
2937 include 'COMMON.LOCAL'
2938 include 'COMMON.INTERACT'
2939 include 'COMMON.VAR'
2940 include 'COMMON.IOUNITS'
2941 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2946 dxi=dc_norm(1,nres+i)
2947 dyi=dc_norm(2,nres+i)
2948 dzi=dc_norm(3,nres+i)
2949 dsci_inv=dsc_inv(itypi)
2951 dscj_inv=dsc_inv(itypj)
2955 dxj=dc_norm(1,nres+j)
2956 dyj=dc_norm(2,nres+j)
2957 dzj=dc_norm(3,nres+j)
2958 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2963 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2964 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2965 om12=dxi*dxj+dyi*dyj+dzi*dzj
2967 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2968 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2974 deltat12=om2-om1+2.0d0
2976 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2977 & +akct*deltad*deltat12
2978 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2979 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2980 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2981 c & " deltat12",deltat12," eij",eij
2982 ed=2*akcm*deltad+akct*deltat12
2984 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
2985 eom1=-2*akth*deltat1-pom1-om2*pom2
2986 eom2= 2*akth*deltat2+pom1-om1*pom2
2989 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2992 ghpbx(k,i)=ghpbx(k,i)-gg(k)
2993 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
2994 ghpbx(k,j)=ghpbx(k,j)+gg(k)
2995 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
2998 C Calculate the components of the gradient in DC and X
3002 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3007 C--------------------------------------------------------------------------
3008 subroutine ebond(estr)
3010 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3012 implicit real*8 (a-h,o-z)
3013 include 'DIMENSIONS'
3014 include 'COMMON.LOCAL'
3015 include 'COMMON.GEO'
3016 include 'COMMON.INTERACT'
3017 include 'COMMON.DERIV'
3018 include 'COMMON.VAR'
3019 include 'COMMON.CHAIN'
3020 include 'COMMON.IOUNITS'
3021 include 'COMMON.NAMES'
3022 include 'COMMON.FFIELD'
3023 include 'COMMON.CONTROL'
3024 double precision u(3),ud(3)
3027 diff = vbld(i)-vbldp0
3028 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3031 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3036 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3043 diff=vbld(i+nres)-vbldsc0(1,iti)
3044 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3045 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3046 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3048 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3052 diff=vbld(i+nres)-vbldsc0(j,iti)
3053 ud(j)=aksc(j,iti)*diff
3054 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3068 uprod2=uprod2*u(k)*u(k)
3072 usumsqder=usumsqder+ud(j)*uprod2
3074 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3075 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3076 estr=estr+uprod/usum
3078 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3086 C--------------------------------------------------------------------------
3087 subroutine ebend(etheta)
3089 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3090 C angles gamma and its derivatives in consecutive thetas and gammas.
3092 implicit real*8 (a-h,o-z)
3093 include 'DIMENSIONS'
3094 include 'sizesclu.dat'
3095 include 'COMMON.LOCAL'
3096 include 'COMMON.GEO'
3097 include 'COMMON.INTERACT'
3098 include 'COMMON.DERIV'
3099 include 'COMMON.VAR'
3100 include 'COMMON.CHAIN'
3101 include 'COMMON.IOUNITS'
3102 include 'COMMON.NAMES'
3103 include 'COMMON.FFIELD'
3104 common /calcthet/ term1,term2,termm,diffak,ratak,
3105 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3106 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3107 double precision y(2),z(2)
3109 time11=dexp(-2*time)
3112 c write (iout,*) "nres",nres
3113 c write (*,'(a,i2)') 'EBEND ICG=',icg
3114 c write (iout,*) ithet_start,ithet_end
3115 do i=ithet_start,ithet_end
3116 C Zero the energy function and its derivative at 0 or pi.
3117 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3119 c if (i.gt.ithet_start .and.
3120 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3121 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3129 c if (i.lt.nres .and. itel(i).ne.0) then
3141 call proc_proc(phii,icrc)
3142 if (icrc.eq.1) phii=150.0
3156 call proc_proc(phii1,icrc)
3157 if (icrc.eq.1) phii1=150.0
3169 C Calculate the "mean" value of theta from the part of the distribution
3170 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3171 C In following comments this theta will be referred to as t_c.
3172 thet_pred_mean=0.0d0
3176 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3178 c write (iout,*) "thet_pred_mean",thet_pred_mean
3179 dthett=thet_pred_mean*ssd
3180 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3181 c write (iout,*) "thet_pred_mean",thet_pred_mean
3182 C Derivatives of the "mean" values in gamma1 and gamma2.
3183 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3184 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3185 if (theta(i).gt.pi-delta) then
3186 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3188 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3189 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3190 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3192 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3194 else if (theta(i).lt.delta) then
3195 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3196 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3197 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3199 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3200 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3203 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3206 etheta=etheta+ethetai
3207 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3208 c & rad2deg*phii,rad2deg*phii1,ethetai
3209 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3210 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3211 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3214 C Ufff.... We've done all this!!!
3217 C---------------------------------------------------------------------------
3218 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3220 implicit real*8 (a-h,o-z)
3221 include 'DIMENSIONS'
3222 include 'COMMON.LOCAL'
3223 include 'COMMON.IOUNITS'
3224 common /calcthet/ term1,term2,termm,diffak,ratak,
3225 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3226 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3227 C Calculate the contributions to both Gaussian lobes.
3228 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3229 C The "polynomial part" of the "standard deviation" of this part of
3233 sig=sig*thet_pred_mean+polthet(j,it)
3235 C Derivative of the "interior part" of the "standard deviation of the"
3236 C gamma-dependent Gaussian lobe in t_c.
3237 sigtc=3*polthet(3,it)
3239 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3242 C Set the parameters of both Gaussian lobes of the distribution.
3243 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3244 fac=sig*sig+sigc0(it)
3247 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3248 sigsqtc=-4.0D0*sigcsq*sigtc
3249 c print *,i,sig,sigtc,sigsqtc
3250 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3251 sigtc=-sigtc/(fac*fac)
3252 C Following variable is sigma(t_c)**(-2)
3253 sigcsq=sigcsq*sigcsq
3255 sig0inv=1.0D0/sig0i**2
3256 delthec=thetai-thet_pred_mean
3257 delthe0=thetai-theta0i
3258 term1=-0.5D0*sigcsq*delthec*delthec
3259 term2=-0.5D0*sig0inv*delthe0*delthe0
3260 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3261 C NaNs in taking the logarithm. We extract the largest exponent which is added
3262 C to the energy (this being the log of the distribution) at the end of energy
3263 C term evaluation for this virtual-bond angle.
3264 if (term1.gt.term2) then
3266 term2=dexp(term2-termm)
3270 term1=dexp(term1-termm)
3273 C The ratio between the gamma-independent and gamma-dependent lobes of
3274 C the distribution is a Gaussian function of thet_pred_mean too.
3275 diffak=gthet(2,it)-thet_pred_mean
3276 ratak=diffak/gthet(3,it)**2
3277 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3278 C Let's differentiate it in thet_pred_mean NOW.
3280 C Now put together the distribution terms to make complete distribution.
3281 termexp=term1+ak*term2
3282 termpre=sigc+ak*sig0i
3283 C Contribution of the bending energy from this theta is just the -log of
3284 C the sum of the contributions from the two lobes and the pre-exponential
3285 C factor. Simple enough, isn't it?
3286 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3287 C NOW the derivatives!!!
3288 C 6/6/97 Take into account the deformation.
3289 E_theta=(delthec*sigcsq*term1
3290 & +ak*delthe0*sig0inv*term2)/termexp
3291 E_tc=((sigtc+aktc*sig0i)/termpre
3292 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3293 & aktc*term2)/termexp)
3296 c-----------------------------------------------------------------------------
3297 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3298 implicit real*8 (a-h,o-z)
3299 include 'DIMENSIONS'
3300 include 'COMMON.LOCAL'
3301 include 'COMMON.IOUNITS'
3302 common /calcthet/ term1,term2,termm,diffak,ratak,
3303 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3304 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3305 delthec=thetai-thet_pred_mean
3306 delthe0=thetai-theta0i
3307 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3308 t3 = thetai-thet_pred_mean
3312 t14 = t12+t6*sigsqtc
3314 t21 = thetai-theta0i
3320 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3321 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3322 & *(-t12*t9-ak*sig0inv*t27)
3326 C--------------------------------------------------------------------------
3327 subroutine ebend(etheta)
3329 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3330 C angles gamma and its derivatives in consecutive thetas and gammas.
3331 C ab initio-derived potentials from
3332 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3334 implicit real*8 (a-h,o-z)
3335 include 'DIMENSIONS'
3336 include 'COMMON.LOCAL'
3337 include 'COMMON.GEO'
3338 include 'COMMON.INTERACT'
3339 include 'COMMON.DERIV'
3340 include 'COMMON.VAR'
3341 include 'COMMON.CHAIN'
3342 include 'COMMON.IOUNITS'
3343 include 'COMMON.NAMES'
3344 include 'COMMON.FFIELD'
3345 include 'COMMON.CONTROL'
3346 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3347 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3348 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3349 & sinph1ph2(maxdouble,maxdouble)
3350 logical lprn /.false./, lprn1 /.false./
3352 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3353 do i=ithet_start,ithet_end
3357 theti2=0.5d0*theta(i)
3358 ityp2=ithetyp(itype(i-1))
3360 coskt(k)=dcos(k*theti2)
3361 sinkt(k)=dsin(k*theti2)
3366 if (phii.ne.phii) phii=150.0
3370 ityp1=ithetyp(itype(i-2))
3372 cosph1(k)=dcos(k*phii)
3373 sinph1(k)=dsin(k*phii)
3386 if (phii1.ne.phii1) phii1=150.0
3391 ityp3=ithetyp(itype(i))
3393 cosph2(k)=dcos(k*phii1)
3394 sinph2(k)=dsin(k*phii1)
3404 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3405 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3407 ethetai=aa0thet(ityp1,ityp2,ityp3)
3410 ccl=cosph1(l)*cosph2(k-l)
3411 ssl=sinph1(l)*sinph2(k-l)
3412 scl=sinph1(l)*cosph2(k-l)
3413 csl=cosph1(l)*sinph2(k-l)
3414 cosph1ph2(l,k)=ccl-ssl
3415 cosph1ph2(k,l)=ccl+ssl
3416 sinph1ph2(l,k)=scl+csl
3417 sinph1ph2(k,l)=scl-csl
3421 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3422 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3423 write (iout,*) "coskt and sinkt"
3425 write (iout,*) k,coskt(k),sinkt(k)
3429 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3430 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3433 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3434 & " ethetai",ethetai
3437 write (iout,*) "cosph and sinph"
3439 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3441 write (iout,*) "cosph1ph2 and sinph2ph2"
3444 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3445 & sinph1ph2(l,k),sinph1ph2(k,l)
3448 write(iout,*) "ethetai",ethetai
3452 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3453 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3454 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3455 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3456 ethetai=ethetai+sinkt(m)*aux
3457 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3458 dephii=dephii+k*sinkt(m)*(
3459 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3460 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3461 dephii1=dephii1+k*sinkt(m)*(
3462 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3463 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3465 & write (iout,*) "m",m," k",k," bbthet",
3466 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3467 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3468 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3469 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3473 & write(iout,*) "ethetai",ethetai
3477 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3478 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3479 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3480 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3481 ethetai=ethetai+sinkt(m)*aux
3482 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3483 dephii=dephii+l*sinkt(m)*(
3484 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3485 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3486 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3487 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3488 dephii1=dephii1+(k-l)*sinkt(m)*(
3489 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3490 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3491 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3492 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3494 write (iout,*) "m",m," k",k," l",l," ffthet",
3495 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3496 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3497 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3498 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3499 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3500 & cosph1ph2(k,l)*sinkt(m),
3501 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3507 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3508 & i,theta(i)*rad2deg,phii*rad2deg,
3509 & phii1*rad2deg,ethetai
3510 etheta=etheta+ethetai
3511 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3512 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3513 gloc(nphi+i-2,icg)=wang*dethetai
3519 c-----------------------------------------------------------------------------
3520 subroutine esc(escloc)
3521 C Calculate the local energy of a side chain and its derivatives in the
3522 C corresponding virtual-bond valence angles THETA and the spherical angles
3524 implicit real*8 (a-h,o-z)
3525 include 'DIMENSIONS'
3526 include 'sizesclu.dat'
3527 include 'COMMON.GEO'
3528 include 'COMMON.LOCAL'
3529 include 'COMMON.VAR'
3530 include 'COMMON.INTERACT'
3531 include 'COMMON.DERIV'
3532 include 'COMMON.CHAIN'
3533 include 'COMMON.IOUNITS'
3534 include 'COMMON.NAMES'
3535 include 'COMMON.FFIELD'
3536 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3537 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3538 common /sccalc/ time11,time12,time112,theti,it,nlobit
3541 c write (iout,'(a)') 'ESC'
3542 do i=loc_start,loc_end
3544 if (it.eq.10) goto 1
3546 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3547 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3548 theti=theta(i+1)-pipol
3552 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3554 if (x(2).gt.pi-delta) then
3558 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3560 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3561 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3563 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3564 & ddersc0(1),dersc(1))
3565 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3566 & ddersc0(3),dersc(3))
3568 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3570 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3571 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3572 & dersc0(2),esclocbi,dersc02)
3573 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3575 call splinthet(x(2),0.5d0*delta,ss,ssd)
3580 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3582 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3583 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3585 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3587 c write (iout,*) escloci
3588 else if (x(2).lt.delta) then
3592 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3594 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3595 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3597 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3598 & ddersc0(1),dersc(1))
3599 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3600 & ddersc0(3),dersc(3))
3602 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3604 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3605 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3606 & dersc0(2),esclocbi,dersc02)
3607 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3612 call splinthet(x(2),0.5d0*delta,ss,ssd)
3614 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3616 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3617 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3619 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3620 c write (iout,*) escloci
3622 call enesc(x,escloci,dersc,ddummy,.false.)
3625 escloc=escloc+escloci
3626 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3628 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3630 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3631 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3636 C---------------------------------------------------------------------------
3637 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3638 implicit real*8 (a-h,o-z)
3639 include 'DIMENSIONS'
3640 include 'COMMON.GEO'
3641 include 'COMMON.LOCAL'
3642 include 'COMMON.IOUNITS'
3643 common /sccalc/ time11,time12,time112,theti,it,nlobit
3644 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3645 double precision contr(maxlob,-1:1)
3647 c write (iout,*) 'it=',it,' nlobit=',nlobit
3651 if (mixed) ddersc(j)=0.0d0
3655 C Because of periodicity of the dependence of the SC energy in omega we have
3656 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3657 C To avoid underflows, first compute & store the exponents.
3665 z(k)=x(k)-censc(k,j,it)
3670 Axk=Axk+gaussc(l,k,j,it)*z(l)
3676 expfac=expfac+Ax(k,j,iii)*z(k)
3684 C As in the case of ebend, we want to avoid underflows in exponentiation and
3685 C subsequent NaNs and INFs in energy calculation.
3686 C Find the largest exponent
3690 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3694 cd print *,'it=',it,' emin=',emin
3696 C Compute the contribution to SC energy and derivatives
3700 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3701 cd print *,'j=',j,' expfac=',expfac
3702 escloc_i=escloc_i+expfac
3704 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3708 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3709 & +gaussc(k,2,j,it))*expfac
3716 dersc(1)=dersc(1)/cos(theti)**2
3717 ddersc(1)=ddersc(1)/cos(theti)**2
3720 escloci=-(dlog(escloc_i)-emin)
3722 dersc(j)=dersc(j)/escloc_i
3726 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3731 C------------------------------------------------------------------------------
3732 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3733 implicit real*8 (a-h,o-z)
3734 include 'DIMENSIONS'
3735 include 'COMMON.GEO'
3736 include 'COMMON.LOCAL'
3737 include 'COMMON.IOUNITS'
3738 common /sccalc/ time11,time12,time112,theti,it,nlobit
3739 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3740 double precision contr(maxlob)
3751 z(k)=x(k)-censc(k,j,it)
3757 Axk=Axk+gaussc(l,k,j,it)*z(l)
3763 expfac=expfac+Ax(k,j)*z(k)
3768 C As in the case of ebend, we want to avoid underflows in exponentiation and
3769 C subsequent NaNs and INFs in energy calculation.
3770 C Find the largest exponent
3773 if (emin.gt.contr(j)) emin=contr(j)
3777 C Compute the contribution to SC energy and derivatives
3781 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3782 escloc_i=escloc_i+expfac
3784 dersc(k)=dersc(k)+Ax(k,j)*expfac
3786 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3787 & +gaussc(1,2,j,it))*expfac
3791 dersc(1)=dersc(1)/cos(theti)**2
3792 dersc12=dersc12/cos(theti)**2
3793 escloci=-(dlog(escloc_i)-emin)
3795 dersc(j)=dersc(j)/escloc_i
3797 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3801 c----------------------------------------------------------------------------------
3802 subroutine esc(escloc)
3803 C Calculate the local energy of a side chain and its derivatives in the
3804 C corresponding virtual-bond valence angles THETA and the spherical angles
3805 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3806 C added by Urszula Kozlowska. 07/11/2007
3808 implicit real*8 (a-h,o-z)
3809 include 'DIMENSIONS'
3810 include 'COMMON.GEO'
3811 include 'COMMON.LOCAL'
3812 include 'COMMON.VAR'
3813 include 'COMMON.SCROT'
3814 include 'COMMON.INTERACT'
3815 include 'COMMON.DERIV'
3816 include 'COMMON.CHAIN'
3817 include 'COMMON.IOUNITS'
3818 include 'COMMON.NAMES'
3819 include 'COMMON.FFIELD'
3820 include 'COMMON.CONTROL'
3821 include 'COMMON.VECTORS'
3822 double precision x_prime(3),y_prime(3),z_prime(3)
3823 & , sumene,dsc_i,dp2_i,x(65),
3824 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3825 & de_dxx,de_dyy,de_dzz,de_dt
3826 double precision s1_t,s1_6_t,s2_t,s2_6_t
3828 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3829 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3830 & dt_dCi(3),dt_dCi1(3)
3831 common /sccalc/ time11,time12,time112,theti,it,nlobit
3834 do i=loc_start,loc_end
3835 costtab(i+1) =dcos(theta(i+1))
3836 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3837 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3838 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3839 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3840 cosfac=dsqrt(cosfac2)
3841 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3842 sinfac=dsqrt(sinfac2)
3844 if (it.eq.10) goto 1
3846 C Compute the axes of tghe local cartesian coordinates system; store in
3847 c x_prime, y_prime and z_prime
3854 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3855 C & dc_norm(3,i+nres)
3857 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3858 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3861 z_prime(j) = -uz(j,i-1)
3864 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3865 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3866 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3867 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3868 c & " xy",scalar(x_prime(1),y_prime(1)),
3869 c & " xz",scalar(x_prime(1),z_prime(1)),
3870 c & " yy",scalar(y_prime(1),y_prime(1)),
3871 c & " yz",scalar(y_prime(1),z_prime(1)),
3872 c & " zz",scalar(z_prime(1),z_prime(1))
3874 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3875 C to local coordinate system. Store in xx, yy, zz.
3881 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3882 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3883 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3890 C Compute the energy of the ith side cbain
3892 c write (2,*) "xx",xx," yy",yy," zz",zz
3895 x(j) = sc_parmin(j,it)
3898 Cc diagnostics - remove later
3900 yy1 = dsin(alph(2))*dcos(omeg(2))
3901 zz1 = -dsin(alph(2))*dsin(omeg(2))
3902 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3903 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3905 C," --- ", xx_w,yy_w,zz_w
3908 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3909 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3911 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3912 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3914 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3915 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3916 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3917 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3918 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3920 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3921 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3922 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3923 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3924 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3926 dsc_i = 0.743d0+x(61)
3928 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3929 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3930 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3931 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3932 s1=(1+x(63))/(0.1d0 + dscp1)
3933 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3934 s2=(1+x(65))/(0.1d0 + dscp2)
3935 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3936 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3937 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3938 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3940 c & dscp1,dscp2,sumene
3941 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3942 escloc = escloc + sumene
3943 c write (2,*) "escloc",escloc
3944 if (.not. calc_grad) goto 1
3947 C This section to check the numerical derivatives of the energy of ith side
3948 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3949 C #define DEBUG in the code to turn it on.
3951 write (2,*) "sumene =",sumene
3955 write (2,*) xx,yy,zz
3956 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3957 de_dxx_num=(sumenep-sumene)/aincr
3959 write (2,*) "xx+ sumene from enesc=",sumenep
3962 write (2,*) xx,yy,zz
3963 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3964 de_dyy_num=(sumenep-sumene)/aincr
3966 write (2,*) "yy+ sumene from enesc=",sumenep
3969 write (2,*) xx,yy,zz
3970 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3971 de_dzz_num=(sumenep-sumene)/aincr
3973 write (2,*) "zz+ sumene from enesc=",sumenep
3974 costsave=cost2tab(i+1)
3975 sintsave=sint2tab(i+1)
3976 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
3977 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
3978 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3979 de_dt_num=(sumenep-sumene)/aincr
3980 write (2,*) " t+ sumene from enesc=",sumenep
3981 cost2tab(i+1)=costsave
3982 sint2tab(i+1)=sintsave
3983 C End of diagnostics section.
3986 C Compute the gradient of esc
3988 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
3989 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
3990 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
3991 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
3992 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
3993 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
3994 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
3995 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
3996 pom1=(sumene3*sint2tab(i+1)+sumene1)
3997 & *(pom_s1/dscp1+pom_s16*dscp1**4)
3998 pom2=(sumene4*cost2tab(i+1)+sumene2)
3999 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4000 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4001 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4002 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4004 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4005 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4006 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4008 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4009 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4010 & +(pom1+pom2)*pom_dx
4012 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4015 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4016 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4017 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4019 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4020 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4021 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4022 & +x(59)*zz**2 +x(60)*xx*zz
4023 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4024 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4025 & +(pom1-pom2)*pom_dy
4027 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4030 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4031 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4032 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4033 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4034 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4035 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4036 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4037 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4039 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4042 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4043 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4044 & +pom1*pom_dt1+pom2*pom_dt2
4046 write(2,*), "de_dt = ", de_dt,de_dt_num
4050 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4051 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4052 cosfac2xx=cosfac2*xx
4053 sinfac2yy=sinfac2*yy
4055 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4057 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4059 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4060 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4061 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4062 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4063 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4064 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4065 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4066 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4067 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4068 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4072 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4073 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4076 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4077 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4078 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4080 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4081 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4085 dXX_Ctab(k,i)=dXX_Ci(k)
4086 dXX_C1tab(k,i)=dXX_Ci1(k)
4087 dYY_Ctab(k,i)=dYY_Ci(k)
4088 dYY_C1tab(k,i)=dYY_Ci1(k)
4089 dZZ_Ctab(k,i)=dZZ_Ci(k)
4090 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4091 dXX_XYZtab(k,i)=dXX_XYZ(k)
4092 dYY_XYZtab(k,i)=dYY_XYZ(k)
4093 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4097 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4098 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4099 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4100 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4101 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4103 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4104 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4105 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4106 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4107 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4108 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4109 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4110 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4112 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4113 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4115 C to check gradient call subroutine check_grad
4122 c------------------------------------------------------------------------------
4123 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4125 C This procedure calculates two-body contact function g(rij) and its derivative:
4128 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4131 C where x=(rij-r0ij)/delta
4133 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4136 double precision rij,r0ij,eps0ij,fcont,fprimcont
4137 double precision x,x2,x4,delta
4141 if (x.lt.-1.0D0) then
4144 else if (x.le.1.0D0) then
4147 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4148 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4155 c------------------------------------------------------------------------------
4156 subroutine splinthet(theti,delta,ss,ssder)
4157 implicit real*8 (a-h,o-z)
4158 include 'DIMENSIONS'
4159 include 'sizesclu.dat'
4160 include 'COMMON.VAR'
4161 include 'COMMON.GEO'
4164 if (theti.gt.pipol) then
4165 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4167 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4172 c------------------------------------------------------------------------------
4173 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4175 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4176 double precision ksi,ksi2,ksi3,a1,a2,a3
4177 a1=fprim0*delta/(f1-f0)
4183 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4184 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4187 c------------------------------------------------------------------------------
4188 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4190 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4191 double precision ksi,ksi2,ksi3,a1,a2,a3
4196 a2=3*(f1x-f0x)-2*fprim0x*delta
4197 a3=fprim0x*delta-2*(f1x-f0x)
4198 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4201 C-----------------------------------------------------------------------------
4203 C-----------------------------------------------------------------------------
4204 subroutine etor(etors,edihcnstr,fact)
4205 implicit real*8 (a-h,o-z)
4206 include 'DIMENSIONS'
4207 include 'sizesclu.dat'
4208 include 'COMMON.VAR'
4209 include 'COMMON.GEO'
4210 include 'COMMON.LOCAL'
4211 include 'COMMON.TORSION'
4212 include 'COMMON.INTERACT'
4213 include 'COMMON.DERIV'
4214 include 'COMMON.CHAIN'
4215 include 'COMMON.NAMES'
4216 include 'COMMON.IOUNITS'
4217 include 'COMMON.FFIELD'
4218 include 'COMMON.TORCNSTR'
4220 C Set lprn=.true. for debugging
4224 do i=iphi_start,iphi_end
4225 itori=itortyp(itype(i-2))
4226 itori1=itortyp(itype(i-1))
4229 C Proline-Proline pair is a special case...
4230 if (itori.eq.3 .and. itori1.eq.3) then
4231 if (phii.gt.-dwapi3) then
4233 fac=1.0D0/(1.0D0-cosphi)
4234 etorsi=v1(1,3,3)*fac
4235 etorsi=etorsi+etorsi
4236 etors=etors+etorsi-v1(1,3,3)
4237 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4240 v1ij=v1(j+1,itori,itori1)
4241 v2ij=v2(j+1,itori,itori1)
4244 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4245 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4249 v1ij=v1(j,itori,itori1)
4250 v2ij=v2(j,itori,itori1)
4253 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4254 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4258 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4259 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4260 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4261 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4262 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4264 ! 6/20/98 - dihedral angle constraints
4267 itori=idih_constr(i)
4269 difi=pinorm(phii-phi0(i))
4270 if (difi.gt.drange(i)) then
4272 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4273 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4274 else if (difi.lt.-drange(i)) then
4276 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4277 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4279 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4280 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4282 write (iout,*) 'edihcnstr',edihcnstr
4285 c------------------------------------------------------------------------------
4287 subroutine etor(etors,edihcnstr,fact)
4288 implicit real*8 (a-h,o-z)
4289 include 'DIMENSIONS'
4290 include 'sizesclu.dat'
4291 include 'COMMON.VAR'
4292 include 'COMMON.GEO'
4293 include 'COMMON.LOCAL'
4294 include 'COMMON.TORSION'
4295 include 'COMMON.INTERACT'
4296 include 'COMMON.DERIV'
4297 include 'COMMON.CHAIN'
4298 include 'COMMON.NAMES'
4299 include 'COMMON.IOUNITS'
4300 include 'COMMON.FFIELD'
4301 include 'COMMON.TORCNSTR'
4303 C Set lprn=.true. for debugging
4307 do i=iphi_start,iphi_end
4308 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4309 itori=itortyp(itype(i-2))
4310 itori1=itortyp(itype(i-1))
4313 C Regular cosine and sine terms
4314 do j=1,nterm(itori,itori1)
4315 v1ij=v1(j,itori,itori1)
4316 v2ij=v2(j,itori,itori1)
4319 etors=etors+v1ij*cosphi+v2ij*sinphi
4320 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4324 C E = SUM ----------------------------------- - v1
4325 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4327 cosphi=dcos(0.5d0*phii)
4328 sinphi=dsin(0.5d0*phii)
4329 do j=1,nlor(itori,itori1)
4330 vl1ij=vlor1(j,itori,itori1)
4331 vl2ij=vlor2(j,itori,itori1)
4332 vl3ij=vlor3(j,itori,itori1)
4333 pom=vl2ij*cosphi+vl3ij*sinphi
4334 pom1=1.0d0/(pom*pom+1.0d0)
4335 etors=etors+vl1ij*pom1
4337 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4339 C Subtract the constant term
4340 etors=etors-v0(itori,itori1)
4342 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4343 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4344 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4345 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4346 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4349 ! 6/20/98 - dihedral angle constraints
4351 c write (iout,*) "Dihedral angle restraint energy"
4353 itori=idih_constr(i)
4355 difi=pinorm(phii-phi0(i))
4356 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
4357 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
4358 if (difi.gt.drange(i)) then
4360 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4361 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4362 c write (iout,*) 0.25d0*ftors*difi**4
4363 else if (difi.lt.-drange(i)) then
4365 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4366 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4367 c write (iout,*) 0.25d0*ftors*difi**4
4370 c write (iout,*) 'edihcnstr',edihcnstr
4373 c----------------------------------------------------------------------------
4374 subroutine etor_d(etors_d,fact2)
4375 C 6/23/01 Compute double torsional energy
4376 implicit real*8 (a-h,o-z)
4377 include 'DIMENSIONS'
4378 include 'sizesclu.dat'
4379 include 'COMMON.VAR'
4380 include 'COMMON.GEO'
4381 include 'COMMON.LOCAL'
4382 include 'COMMON.TORSION'
4383 include 'COMMON.INTERACT'
4384 include 'COMMON.DERIV'
4385 include 'COMMON.CHAIN'
4386 include 'COMMON.NAMES'
4387 include 'COMMON.IOUNITS'
4388 include 'COMMON.FFIELD'
4389 include 'COMMON.TORCNSTR'
4391 C Set lprn=.true. for debugging
4395 do i=iphi_start,iphi_end-1
4396 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4398 itori=itortyp(itype(i-2))
4399 itori1=itortyp(itype(i-1))
4400 itori2=itortyp(itype(i))
4405 C Regular cosine and sine terms
4406 do j=1,ntermd_1(itori,itori1,itori2)
4407 v1cij=v1c(1,j,itori,itori1,itori2)
4408 v1sij=v1s(1,j,itori,itori1,itori2)
4409 v2cij=v1c(2,j,itori,itori1,itori2)
4410 v2sij=v1s(2,j,itori,itori1,itori2)
4411 cosphi1=dcos(j*phii)
4412 sinphi1=dsin(j*phii)
4413 cosphi2=dcos(j*phii1)
4414 sinphi2=dsin(j*phii1)
4415 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4416 & v2cij*cosphi2+v2sij*sinphi2
4417 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4418 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4420 do k=2,ntermd_2(itori,itori1,itori2)
4422 v1cdij = v2c(k,l,itori,itori1,itori2)
4423 v2cdij = v2c(l,k,itori,itori1,itori2)
4424 v1sdij = v2s(k,l,itori,itori1,itori2)
4425 v2sdij = v2s(l,k,itori,itori1,itori2)
4426 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4427 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4428 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4429 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4430 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4431 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4432 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4433 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4434 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4435 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4438 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4439 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4445 c------------------------------------------------------------------------------
4446 subroutine eback_sc_corr(esccor,fact)
4447 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4448 c conformational states; temporarily implemented as differences
4449 c between UNRES torsional potentials (dependent on three types of
4450 c residues) and the torsional potentials dependent on all 20 types
4451 c of residues computed from AM1 energy surfaces of terminally-blocked
4452 c amino-acid residues.
4453 implicit real*8 (a-h,o-z)
4454 include 'DIMENSIONS'
4455 include 'COMMON.VAR'
4456 include 'COMMON.GEO'
4457 include 'COMMON.LOCAL'
4458 include 'COMMON.TORSION'
4459 include 'COMMON.SCCOR'
4460 include 'COMMON.INTERACT'
4461 include 'COMMON.DERIV'
4462 include 'COMMON.CHAIN'
4463 include 'COMMON.NAMES'
4464 include 'COMMON.IOUNITS'
4465 include 'COMMON.FFIELD'
4466 include 'COMMON.CONTROL'
4468 C Set lprn=.true. for debugging
4471 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4473 do i=itau_start,itau_end
4475 isccori=isccortyp(itype(i-2))
4476 isccori1=isccortyp(itype(i-1))
4478 cccc Added 9 May 2012
4479 cc Tauangle is torsional engle depending on the value of first digit
4480 c(see comment below)
4481 cc Omicron is flat angle depending on the value of first digit
4482 c(see comment below)
4485 do intertyp=1,3 !intertyp
4486 cc Added 09 May 2012 (Adasko)
4487 cc Intertyp means interaction type of backbone mainchain correlation:
4488 c 1 = SC...Ca...Ca...Ca
4489 c 2 = Ca...Ca...Ca...SC
4490 c 3 = SC...Ca...Ca...SCi
4492 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4493 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4494 & (itype(i-1).eq.21)))
4495 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4496 & .or.(itype(i-2).eq.21)))
4497 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4498 & (itype(i-1).eq.21)))) cycle
4499 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4500 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4502 do j=1,nterm_sccor(isccori,isccori1)
4503 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4504 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4505 cosphi=dcos(j*tauangle(intertyp,i))
4506 sinphi=dsin(j*tauangle(intertyp,i))
4507 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4508 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4510 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4511 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4512 c &gloc_sc(intertyp,i-3,icg)
4514 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4515 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4516 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4517 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4518 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4524 c------------------------------------------------------------------------------
4525 subroutine multibody(ecorr)
4526 C This subroutine calculates multi-body contributions to energy following
4527 C the idea of Skolnick et al. If side chains I and J make a contact and
4528 C at the same time side chains I+1 and J+1 make a contact, an extra
4529 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4530 implicit real*8 (a-h,o-z)
4531 include 'DIMENSIONS'
4532 include 'COMMON.IOUNITS'
4533 include 'COMMON.DERIV'
4534 include 'COMMON.INTERACT'
4535 include 'COMMON.CONTACTS'
4536 double precision gx(3),gx1(3)
4539 C Set lprn=.true. for debugging
4543 write (iout,'(a)') 'Contact function values:'
4545 write (iout,'(i2,20(1x,i2,f10.5))')
4546 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4561 num_conti=num_cont(i)
4562 num_conti1=num_cont(i1)
4567 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4568 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4569 cd & ' ishift=',ishift
4570 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4571 C The system gains extra energy.
4572 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4573 endif ! j1==j+-ishift
4582 c------------------------------------------------------------------------------
4583 double precision function esccorr(i,j,k,l,jj,kk)
4584 implicit real*8 (a-h,o-z)
4585 include 'DIMENSIONS'
4586 include 'COMMON.IOUNITS'
4587 include 'COMMON.DERIV'
4588 include 'COMMON.INTERACT'
4589 include 'COMMON.CONTACTS'
4590 double precision gx(3),gx1(3)
4595 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4596 C Calculate the multi-body contribution to energy.
4597 C Calculate multi-body contributions to the gradient.
4598 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4599 cd & k,l,(gacont(m,kk,k),m=1,3)
4601 gx(m) =ekl*gacont(m,jj,i)
4602 gx1(m)=eij*gacont(m,kk,k)
4603 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4604 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4605 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4606 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4610 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4615 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4621 c------------------------------------------------------------------------------
4623 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4624 implicit real*8 (a-h,o-z)
4625 include 'DIMENSIONS'
4626 integer dimen1,dimen2,atom,indx
4627 double precision buffer(dimen1,dimen2)
4628 double precision zapas
4629 common /contacts_hb/ zapas(3,20,maxres,7),
4630 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4631 & num_cont_hb(maxres),jcont_hb(20,maxres)
4632 num_kont=num_cont_hb(atom)
4636 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4639 buffer(i,indx+22)=facont_hb(i,atom)
4640 buffer(i,indx+23)=ees0p(i,atom)
4641 buffer(i,indx+24)=ees0m(i,atom)
4642 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4644 buffer(1,indx+26)=dfloat(num_kont)
4647 c------------------------------------------------------------------------------
4648 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4649 implicit real*8 (a-h,o-z)
4650 include 'DIMENSIONS'
4651 integer dimen1,dimen2,atom,indx
4652 double precision buffer(dimen1,dimen2)
4653 double precision zapas
4654 common /contacts_hb/ zapas(3,20,maxres,7),
4655 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4656 & num_cont_hb(maxres),jcont_hb(20,maxres)
4657 num_kont=buffer(1,indx+26)
4658 num_kont_old=num_cont_hb(atom)
4659 num_cont_hb(atom)=num_kont+num_kont_old
4664 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4667 facont_hb(ii,atom)=buffer(i,indx+22)
4668 ees0p(ii,atom)=buffer(i,indx+23)
4669 ees0m(ii,atom)=buffer(i,indx+24)
4670 jcont_hb(ii,atom)=buffer(i,indx+25)
4674 c------------------------------------------------------------------------------
4676 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4677 C This subroutine calculates multi-body contributions to hydrogen-bonding
4678 implicit real*8 (a-h,o-z)
4679 include 'DIMENSIONS'
4680 include 'sizesclu.dat'
4681 include 'COMMON.IOUNITS'
4683 include 'COMMON.INFO'
4685 include 'COMMON.FFIELD'
4686 include 'COMMON.DERIV'
4687 include 'COMMON.INTERACT'
4688 include 'COMMON.CONTACTS'
4690 parameter (max_cont=maxconts)
4691 parameter (max_dim=2*(8*3+2))
4692 parameter (msglen1=max_cont*max_dim*4)
4693 parameter (msglen2=2*msglen1)
4694 integer source,CorrelType,CorrelID,Error
4695 double precision buffer(max_cont,max_dim)
4697 double precision gx(3),gx1(3)
4700 C Set lprn=.true. for debugging
4705 if (fgProcs.le.1) goto 30
4707 write (iout,'(a)') 'Contact function values:'
4709 write (iout,'(2i3,50(1x,i2,f5.2))')
4710 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4711 & j=1,num_cont_hb(i))
4714 C Caution! Following code assumes that electrostatic interactions concerning
4715 C a given atom are split among at most two processors!
4725 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4728 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4729 if (MyRank.gt.0) then
4730 C Send correlation contributions to the preceding processor
4732 nn=num_cont_hb(iatel_s)
4733 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4734 cd write (iout,*) 'The BUFFER array:'
4736 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4738 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4740 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4741 C Clear the contacts of the atom passed to the neighboring processor
4742 nn=num_cont_hb(iatel_s+1)
4744 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4746 num_cont_hb(iatel_s)=0
4748 cd write (iout,*) 'Processor ',MyID,MyRank,
4749 cd & ' is sending correlation contribution to processor',MyID-1,
4750 cd & ' msglen=',msglen
4751 cd write (*,*) 'Processor ',MyID,MyRank,
4752 cd & ' is sending correlation contribution to processor',MyID-1,
4753 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4754 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4755 cd write (iout,*) 'Processor ',MyID,
4756 cd & ' has sent correlation contribution to processor',MyID-1,
4757 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4758 cd write (*,*) 'Processor ',MyID,
4759 cd & ' has sent correlation contribution to processor',MyID-1,
4760 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4762 endif ! (MyRank.gt.0)
4766 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4767 if (MyRank.lt.fgProcs-1) then
4768 C Receive correlation contributions from the next processor
4770 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4771 cd write (iout,*) 'Processor',MyID,
4772 cd & ' is receiving correlation contribution from processor',MyID+1,
4773 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4774 cd write (*,*) 'Processor',MyID,
4775 cd & ' is receiving correlation contribution from processor',MyID+1,
4776 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4778 do while (nbytes.le.0)
4779 call mp_probe(MyID+1,CorrelType,nbytes)
4781 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4782 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4783 cd write (iout,*) 'Processor',MyID,
4784 cd & ' has received correlation contribution from processor',MyID+1,
4785 cd & ' msglen=',msglen,' nbytes=',nbytes
4786 cd write (iout,*) 'The received BUFFER array:'
4788 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4790 if (msglen.eq.msglen1) then
4791 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4792 else if (msglen.eq.msglen2) then
4793 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4794 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4797 & 'ERROR!!!! message length changed while processing correlations.'
4799 & 'ERROR!!!! message length changed while processing correlations.'
4800 call mp_stopall(Error)
4801 endif ! msglen.eq.msglen1
4802 endif ! MyRank.lt.fgProcs-1
4809 write (iout,'(a)') 'Contact function values:'
4811 write (iout,'(2i3,50(1x,i2,f5.2))')
4812 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4813 & j=1,num_cont_hb(i))
4817 C Remove the loop below after debugging !!!
4824 C Calculate the local-electrostatic correlation terms
4825 do i=iatel_s,iatel_e+1
4827 num_conti=num_cont_hb(i)
4828 num_conti1=num_cont_hb(i+1)
4833 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4834 c & ' jj=',jj,' kk=',kk
4835 if (j1.eq.j+1 .or. j1.eq.j-1) then
4836 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4837 C The system gains extra energy.
4838 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4840 else if (j1.eq.j) then
4841 C Contacts I-J and I-(J+1) occur simultaneously.
4842 C The system loses extra energy.
4843 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4848 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4849 c & ' jj=',jj,' kk=',kk
4851 C Contacts I-J and (I+1)-J occur simultaneously.
4852 C The system loses extra energy.
4853 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4860 c------------------------------------------------------------------------------
4861 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4863 C This subroutine calculates multi-body contributions to hydrogen-bonding
4864 implicit real*8 (a-h,o-z)
4865 include 'DIMENSIONS'
4866 include 'sizesclu.dat'
4867 include 'COMMON.IOUNITS'
4869 include 'COMMON.INFO'
4871 include 'COMMON.FFIELD'
4872 include 'COMMON.DERIV'
4873 include 'COMMON.INTERACT'
4874 include 'COMMON.CONTACTS'
4876 parameter (max_cont=maxconts)
4877 parameter (max_dim=2*(8*3+2))
4878 parameter (msglen1=max_cont*max_dim*4)
4879 parameter (msglen2=2*msglen1)
4880 integer source,CorrelType,CorrelID,Error
4881 double precision buffer(max_cont,max_dim)
4883 double precision gx(3),gx1(3)
4886 C Set lprn=.true. for debugging
4892 if (fgProcs.le.1) goto 30
4894 write (iout,'(a)') 'Contact function values:'
4896 write (iout,'(2i3,50(1x,i2,f5.2))')
4897 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4898 & j=1,num_cont_hb(i))
4901 C Caution! Following code assumes that electrostatic interactions concerning
4902 C a given atom are split among at most two processors!
4912 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4915 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4916 if (MyRank.gt.0) then
4917 C Send correlation contributions to the preceding processor
4919 nn=num_cont_hb(iatel_s)
4920 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4921 cd write (iout,*) 'The BUFFER array:'
4923 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4925 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4927 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4928 C Clear the contacts of the atom passed to the neighboring processor
4929 nn=num_cont_hb(iatel_s+1)
4931 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4933 num_cont_hb(iatel_s)=0
4935 cd write (iout,*) 'Processor ',MyID,MyRank,
4936 cd & ' is sending correlation contribution to processor',MyID-1,
4937 cd & ' msglen=',msglen
4938 cd write (*,*) 'Processor ',MyID,MyRank,
4939 cd & ' is sending correlation contribution to processor',MyID-1,
4940 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4941 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4942 cd write (iout,*) 'Processor ',MyID,
4943 cd & ' has sent correlation contribution to processor',MyID-1,
4944 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4945 cd write (*,*) 'Processor ',MyID,
4946 cd & ' has sent correlation contribution to processor',MyID-1,
4947 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4949 endif ! (MyRank.gt.0)
4953 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4954 if (MyRank.lt.fgProcs-1) then
4955 C Receive correlation contributions from the next processor
4957 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4958 cd write (iout,*) 'Processor',MyID,
4959 cd & ' is receiving correlation contribution from processor',MyID+1,
4960 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4961 cd write (*,*) 'Processor',MyID,
4962 cd & ' is receiving correlation contribution from processor',MyID+1,
4963 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4965 do while (nbytes.le.0)
4966 call mp_probe(MyID+1,CorrelType,nbytes)
4968 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4969 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4970 cd write (iout,*) 'Processor',MyID,
4971 cd & ' has received correlation contribution from processor',MyID+1,
4972 cd & ' msglen=',msglen,' nbytes=',nbytes
4973 cd write (iout,*) 'The received BUFFER array:'
4975 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4977 if (msglen.eq.msglen1) then
4978 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4979 else if (msglen.eq.msglen2) then
4980 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4981 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4984 & 'ERROR!!!! message length changed while processing correlations.'
4986 & 'ERROR!!!! message length changed while processing correlations.'
4987 call mp_stopall(Error)
4988 endif ! msglen.eq.msglen1
4989 endif ! MyRank.lt.fgProcs-1
4996 write (iout,'(a)') 'Contact function values:'
4998 write (iout,'(2i3,50(1x,i2,f5.2))')
4999 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5000 & j=1,num_cont_hb(i))
5006 C Remove the loop below after debugging !!!
5013 C Calculate the dipole-dipole interaction energies
5014 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5015 do i=iatel_s,iatel_e+1
5016 num_conti=num_cont_hb(i)
5023 C Calculate the local-electrostatic correlation terms
5024 do i=iatel_s,iatel_e+1
5026 num_conti=num_cont_hb(i)
5027 num_conti1=num_cont_hb(i+1)
5032 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5033 c & ' jj=',jj,' kk=',kk
5034 if (j1.eq.j+1 .or. j1.eq.j-1) then
5035 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5036 C The system gains extra energy.
5038 sqd1=dsqrt(d_cont(jj,i))
5039 sqd2=dsqrt(d_cont(kk,i1))
5040 sred_geom = sqd1*sqd2
5041 IF (sred_geom.lt.cutoff_corr) THEN
5042 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5044 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5045 c & ' jj=',jj,' kk=',kk
5046 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5047 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5049 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5050 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5053 cd write (iout,*) 'sred_geom=',sred_geom,
5054 cd & ' ekont=',ekont,' fprim=',fprimcont
5055 call calc_eello(i,j,i+1,j1,jj,kk)
5056 if (wcorr4.gt.0.0d0)
5057 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5058 if (wcorr5.gt.0.0d0)
5059 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5060 c print *,"wcorr5",ecorr5
5061 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5062 cd write(2,*)'ijkl',i,j,i+1,j1
5063 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5064 & .or. wturn6.eq.0.0d0))then
5065 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5066 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5067 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5068 cd & 'ecorr6=',ecorr6
5069 cd write (iout,'(4e15.5)') sred_geom,
5070 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5071 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5072 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5073 else if (wturn6.gt.0.0d0
5074 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5075 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5076 eturn6=eturn6+eello_turn6(i,jj,kk)
5077 cd write (2,*) 'multibody_eello:eturn6',eturn6
5081 else if (j1.eq.j) then
5082 C Contacts I-J and I-(J+1) occur simultaneously.
5083 C The system loses extra energy.
5084 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5089 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5090 c & ' jj=',jj,' kk=',kk
5092 C Contacts I-J and (I+1)-J occur simultaneously.
5093 C The system loses extra energy.
5094 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5101 c------------------------------------------------------------------------------
5102 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5103 implicit real*8 (a-h,o-z)
5104 include 'DIMENSIONS'
5105 include 'COMMON.IOUNITS'
5106 include 'COMMON.DERIV'
5107 include 'COMMON.INTERACT'
5108 include 'COMMON.CONTACTS'
5109 double precision gx(3),gx1(3)
5119 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5120 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5121 C Following 4 lines for diagnostics.
5126 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5128 c write (iout,*)'Contacts have occurred for peptide groups',
5129 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5130 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5131 C Calculate the multi-body contribution to energy.
5132 ecorr=ecorr+ekont*ees
5134 C Calculate multi-body contributions to the gradient.
5136 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5137 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5138 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5139 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5140 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5141 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5142 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5143 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5144 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5145 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5146 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5147 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5148 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5149 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5153 gradcorr(ll,m)=gradcorr(ll,m)+
5154 & ees*ekl*gacont_hbr(ll,jj,i)-
5155 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5156 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5161 gradcorr(ll,m)=gradcorr(ll,m)+
5162 & ees*eij*gacont_hbr(ll,kk,k)-
5163 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5164 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5171 C---------------------------------------------------------------------------
5172 subroutine dipole(i,j,jj)
5173 implicit real*8 (a-h,o-z)
5174 include 'DIMENSIONS'
5175 include 'sizesclu.dat'
5176 include 'COMMON.IOUNITS'
5177 include 'COMMON.CHAIN'
5178 include 'COMMON.FFIELD'
5179 include 'COMMON.DERIV'
5180 include 'COMMON.INTERACT'
5181 include 'COMMON.CONTACTS'
5182 include 'COMMON.TORSION'
5183 include 'COMMON.VAR'
5184 include 'COMMON.GEO'
5185 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5187 iti1 = itortyp(itype(i+1))
5188 if (j.lt.nres-1) then
5189 itj1 = itortyp(itype(j+1))
5194 dipi(iii,1)=Ub2(iii,i)
5195 dipderi(iii)=Ub2der(iii,i)
5196 dipi(iii,2)=b1(iii,iti1)
5197 dipj(iii,1)=Ub2(iii,j)
5198 dipderj(iii)=Ub2der(iii,j)
5199 dipj(iii,2)=b1(iii,itj1)
5203 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5206 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5209 if (.not.calc_grad) return
5214 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5218 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5223 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5224 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5226 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5228 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5230 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5234 C---------------------------------------------------------------------------
5235 subroutine calc_eello(i,j,k,l,jj,kk)
5237 C This subroutine computes matrices and vectors needed to calculate
5238 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5240 implicit real*8 (a-h,o-z)
5241 include 'DIMENSIONS'
5242 include 'sizesclu.dat'
5243 include 'COMMON.IOUNITS'
5244 include 'COMMON.CHAIN'
5245 include 'COMMON.DERIV'
5246 include 'COMMON.INTERACT'
5247 include 'COMMON.CONTACTS'
5248 include 'COMMON.TORSION'
5249 include 'COMMON.VAR'
5250 include 'COMMON.GEO'
5251 include 'COMMON.FFIELD'
5252 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5253 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5256 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5257 cd & ' jj=',jj,' kk=',kk
5258 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5261 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5262 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5265 call transpose2(aa1(1,1),aa1t(1,1))
5266 call transpose2(aa2(1,1),aa2t(1,1))
5269 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5270 & aa1tder(1,1,lll,kkk))
5271 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5272 & aa2tder(1,1,lll,kkk))
5276 C parallel orientation of the two CA-CA-CA frames.
5278 iti=itortyp(itype(i))
5282 itk1=itortyp(itype(k+1))
5283 itj=itortyp(itype(j))
5284 if (l.lt.nres-1) then
5285 itl1=itortyp(itype(l+1))
5289 C A1 kernel(j+1) A2T
5291 cd write (iout,'(3f10.5,5x,3f10.5)')
5292 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5294 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5295 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5296 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5297 C Following matrices are needed only for 6-th order cumulants
5298 IF (wcorr6.gt.0.0d0) THEN
5299 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5300 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5301 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5302 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5303 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5304 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5305 & ADtEAderx(1,1,1,1,1,1))
5307 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5308 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5309 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5310 & ADtEA1derx(1,1,1,1,1,1))
5312 C End 6-th order cumulants
5315 cd write (2,*) 'In calc_eello6'
5317 cd write (2,*) 'iii=',iii
5319 cd write (2,*) 'kkk=',kkk
5321 cd write (2,'(3(2f10.5),5x)')
5322 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5327 call transpose2(EUgder(1,1,k),auxmat(1,1))
5328 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5329 call transpose2(EUg(1,1,k),auxmat(1,1))
5330 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5331 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5335 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5336 & EAEAderx(1,1,lll,kkk,iii,1))
5340 C A1T kernel(i+1) A2
5341 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5342 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5343 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5344 C Following matrices are needed only for 6-th order cumulants
5345 IF (wcorr6.gt.0.0d0) THEN
5346 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5347 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5348 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5349 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5350 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5351 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5352 & ADtEAderx(1,1,1,1,1,2))
5353 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5354 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5355 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5356 & ADtEA1derx(1,1,1,1,1,2))
5358 C End 6-th order cumulants
5359 call transpose2(EUgder(1,1,l),auxmat(1,1))
5360 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5361 call transpose2(EUg(1,1,l),auxmat(1,1))
5362 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5363 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5367 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5368 & EAEAderx(1,1,lll,kkk,iii,2))
5373 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5374 C They are needed only when the fifth- or the sixth-order cumulants are
5376 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5377 call transpose2(AEA(1,1,1),auxmat(1,1))
5378 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5379 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5380 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5381 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5382 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5383 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5384 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5385 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5386 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5387 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5388 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5389 call transpose2(AEA(1,1,2),auxmat(1,1))
5390 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5391 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5392 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5393 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5394 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5395 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5396 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5397 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5398 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5399 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5400 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5401 C Calculate the Cartesian derivatives of the vectors.
5405 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5406 call matvec2(auxmat(1,1),b1(1,iti),
5407 & AEAb1derx(1,lll,kkk,iii,1,1))
5408 call matvec2(auxmat(1,1),Ub2(1,i),
5409 & AEAb2derx(1,lll,kkk,iii,1,1))
5410 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5411 & AEAb1derx(1,lll,kkk,iii,2,1))
5412 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5413 & AEAb2derx(1,lll,kkk,iii,2,1))
5414 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5415 call matvec2(auxmat(1,1),b1(1,itj),
5416 & AEAb1derx(1,lll,kkk,iii,1,2))
5417 call matvec2(auxmat(1,1),Ub2(1,j),
5418 & AEAb2derx(1,lll,kkk,iii,1,2))
5419 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5420 & AEAb1derx(1,lll,kkk,iii,2,2))
5421 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5422 & AEAb2derx(1,lll,kkk,iii,2,2))
5429 C Antiparallel orientation of the two CA-CA-CA frames.
5431 iti=itortyp(itype(i))
5435 itk1=itortyp(itype(k+1))
5436 itl=itortyp(itype(l))
5437 itj=itortyp(itype(j))
5438 if (j.lt.nres-1) then
5439 itj1=itortyp(itype(j+1))
5443 C A2 kernel(j-1)T A1T
5444 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5445 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5446 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5447 C Following matrices are needed only for 6-th order cumulants
5448 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5449 & j.eq.i+4 .and. l.eq.i+3)) THEN
5450 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5451 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5452 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5453 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5454 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5455 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5456 & ADtEAderx(1,1,1,1,1,1))
5457 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5458 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5459 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5460 & ADtEA1derx(1,1,1,1,1,1))
5462 C End 6-th order cumulants
5463 call transpose2(EUgder(1,1,k),auxmat(1,1))
5464 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5465 call transpose2(EUg(1,1,k),auxmat(1,1))
5466 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5467 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5471 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5472 & EAEAderx(1,1,lll,kkk,iii,1))
5476 C A2T kernel(i+1)T A1
5477 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5478 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5479 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5480 C Following matrices are needed only for 6-th order cumulants
5481 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5482 & j.eq.i+4 .and. l.eq.i+3)) THEN
5483 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5484 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5485 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5486 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5487 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5488 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5489 & ADtEAderx(1,1,1,1,1,2))
5490 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5491 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5492 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5493 & ADtEA1derx(1,1,1,1,1,2))
5495 C End 6-th order cumulants
5496 call transpose2(EUgder(1,1,j),auxmat(1,1))
5497 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5498 call transpose2(EUg(1,1,j),auxmat(1,1))
5499 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5500 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5504 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5505 & EAEAderx(1,1,lll,kkk,iii,2))
5510 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5511 C They are needed only when the fifth- or the sixth-order cumulants are
5513 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5514 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5515 call transpose2(AEA(1,1,1),auxmat(1,1))
5516 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5517 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5518 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5519 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5520 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5521 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5522 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5523 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5524 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5525 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5526 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5527 call transpose2(AEA(1,1,2),auxmat(1,1))
5528 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5529 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5530 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5531 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5532 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5533 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5534 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5535 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5536 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5537 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5538 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5539 C Calculate the Cartesian derivatives of the vectors.
5543 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5544 call matvec2(auxmat(1,1),b1(1,iti),
5545 & AEAb1derx(1,lll,kkk,iii,1,1))
5546 call matvec2(auxmat(1,1),Ub2(1,i),
5547 & AEAb2derx(1,lll,kkk,iii,1,1))
5548 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5549 & AEAb1derx(1,lll,kkk,iii,2,1))
5550 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5551 & AEAb2derx(1,lll,kkk,iii,2,1))
5552 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5553 call matvec2(auxmat(1,1),b1(1,itl),
5554 & AEAb1derx(1,lll,kkk,iii,1,2))
5555 call matvec2(auxmat(1,1),Ub2(1,l),
5556 & AEAb2derx(1,lll,kkk,iii,1,2))
5557 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5558 & AEAb1derx(1,lll,kkk,iii,2,2))
5559 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5560 & AEAb2derx(1,lll,kkk,iii,2,2))
5569 C---------------------------------------------------------------------------
5570 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5571 & KK,KKderg,AKA,AKAderg,AKAderx)
5575 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5576 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5577 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5582 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5584 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5587 cd if (lprn) write (2,*) 'In kernel'
5589 cd if (lprn) write (2,*) 'kkk=',kkk
5591 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5592 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5594 cd write (2,*) 'lll=',lll
5595 cd write (2,*) 'iii=1'
5597 cd write (2,'(3(2f10.5),5x)')
5598 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5601 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5602 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5604 cd write (2,*) 'lll=',lll
5605 cd write (2,*) 'iii=2'
5607 cd write (2,'(3(2f10.5),5x)')
5608 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5615 C---------------------------------------------------------------------------
5616 double precision function eello4(i,j,k,l,jj,kk)
5617 implicit real*8 (a-h,o-z)
5618 include 'DIMENSIONS'
5619 include 'sizesclu.dat'
5620 include 'COMMON.IOUNITS'
5621 include 'COMMON.CHAIN'
5622 include 'COMMON.DERIV'
5623 include 'COMMON.INTERACT'
5624 include 'COMMON.CONTACTS'
5625 include 'COMMON.TORSION'
5626 include 'COMMON.VAR'
5627 include 'COMMON.GEO'
5628 double precision pizda(2,2),ggg1(3),ggg2(3)
5629 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5633 cd print *,'eello4:',i,j,k,l,jj,kk
5634 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5635 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5636 cold eij=facont_hb(jj,i)
5637 cold ekl=facont_hb(kk,k)
5639 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5641 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5642 gcorr_loc(k-1)=gcorr_loc(k-1)
5643 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5645 gcorr_loc(l-1)=gcorr_loc(l-1)
5646 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5648 gcorr_loc(j-1)=gcorr_loc(j-1)
5649 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5654 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5655 & -EAEAderx(2,2,lll,kkk,iii,1)
5656 cd derx(lll,kkk,iii)=0.0d0
5660 cd gcorr_loc(l-1)=0.0d0
5661 cd gcorr_loc(j-1)=0.0d0
5662 cd gcorr_loc(k-1)=0.0d0
5664 cd write (iout,*)'Contacts have occurred for peptide groups',
5665 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5666 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5667 if (j.lt.nres-1) then
5674 if (l.lt.nres-1) then
5682 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5683 ggg1(ll)=eel4*g_contij(ll,1)
5684 ggg2(ll)=eel4*g_contij(ll,2)
5685 ghalf=0.5d0*ggg1(ll)
5687 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5688 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5689 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5690 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5691 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5692 ghalf=0.5d0*ggg2(ll)
5694 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5695 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5696 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5697 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5702 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5703 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5708 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5709 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5715 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5720 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5724 cd write (2,*) iii,gcorr_loc(iii)
5728 cd write (2,*) 'ekont',ekont
5729 cd write (iout,*) 'eello4',ekont*eel4
5732 C---------------------------------------------------------------------------
5733 double precision function eello5(i,j,k,l,jj,kk)
5734 implicit real*8 (a-h,o-z)
5735 include 'DIMENSIONS'
5736 include 'sizesclu.dat'
5737 include 'COMMON.IOUNITS'
5738 include 'COMMON.CHAIN'
5739 include 'COMMON.DERIV'
5740 include 'COMMON.INTERACT'
5741 include 'COMMON.CONTACTS'
5742 include 'COMMON.TORSION'
5743 include 'COMMON.VAR'
5744 include 'COMMON.GEO'
5745 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5746 double precision ggg1(3),ggg2(3)
5747 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5752 C /l\ / \ \ / \ / \ / C
5753 C / \ / \ \ / \ / \ / C
5754 C j| o |l1 | o | o| o | | o |o C
5755 C \ |/k\| |/ \| / |/ \| |/ \| C
5756 C \i/ \ / \ / / \ / \ C
5758 C (I) (II) (III) (IV) C
5760 C eello5_1 eello5_2 eello5_3 eello5_4 C
5762 C Antiparallel chains C
5765 C /j\ / \ \ / \ / \ / C
5766 C / \ / \ \ / \ / \ / C
5767 C j1| o |l | o | o| o | | o |o C
5768 C \ |/k\| |/ \| / |/ \| |/ \| C
5769 C \i/ \ / \ / / \ / \ C
5771 C (I) (II) (III) (IV) C
5773 C eello5_1 eello5_2 eello5_3 eello5_4 C
5775 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5777 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5778 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5783 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5785 itk=itortyp(itype(k))
5786 itl=itortyp(itype(l))
5787 itj=itortyp(itype(j))
5792 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5793 cd & eel5_3_num,eel5_4_num)
5797 derx(lll,kkk,iii)=0.0d0
5801 cd eij=facont_hb(jj,i)
5802 cd ekl=facont_hb(kk,k)
5804 cd write (iout,*)'Contacts have occurred for peptide groups',
5805 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5807 C Contribution from the graph I.
5808 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5809 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5810 call transpose2(EUg(1,1,k),auxmat(1,1))
5811 call matmat2(AEA(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)
5814 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5815 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5817 C Explicit gradient in virtual-dihedral angles.
5818 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5819 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5820 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5821 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5822 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5823 vv(1)=pizda(1,1)-pizda(2,2)
5824 vv(2)=pizda(1,2)+pizda(2,1)
5825 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5826 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5827 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5828 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5829 vv(1)=pizda(1,1)-pizda(2,2)
5830 vv(2)=pizda(1,2)+pizda(2,1)
5832 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5833 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5834 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5836 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5837 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5838 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5840 C Cartesian gradient
5844 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5846 vv(1)=pizda(1,1)-pizda(2,2)
5847 vv(2)=pizda(1,2)+pizda(2,1)
5848 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5849 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5850 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5857 C Contribution from graph II
5858 call transpose2(EE(1,1,itk),auxmat(1,1))
5859 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5860 vv(1)=pizda(1,1)+pizda(2,2)
5861 vv(2)=pizda(2,1)-pizda(1,2)
5862 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5863 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5865 C Explicit gradient in virtual-dihedral angles.
5866 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5867 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5868 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5869 vv(1)=pizda(1,1)+pizda(2,2)
5870 vv(2)=pizda(2,1)-pizda(1,2)
5872 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5873 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5874 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5876 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5877 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5878 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5880 C Cartesian gradient
5884 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5886 vv(1)=pizda(1,1)+pizda(2,2)
5887 vv(2)=pizda(2,1)-pizda(1,2)
5888 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5889 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5890 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5899 C Parallel orientation
5900 C Contribution from graph III
5901 call transpose2(EUg(1,1,l),auxmat(1,1))
5902 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5903 vv(1)=pizda(1,1)-pizda(2,2)
5904 vv(2)=pizda(1,2)+pizda(2,1)
5905 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5906 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5908 C Explicit gradient in virtual-dihedral angles.
5909 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5910 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5911 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5912 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5913 vv(1)=pizda(1,1)-pizda(2,2)
5914 vv(2)=pizda(1,2)+pizda(2,1)
5915 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5916 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5917 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5918 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5919 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5920 vv(1)=pizda(1,1)-pizda(2,2)
5921 vv(2)=pizda(1,2)+pizda(2,1)
5922 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5923 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5924 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5925 C Cartesian gradient
5929 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5931 vv(1)=pizda(1,1)-pizda(2,2)
5932 vv(2)=pizda(1,2)+pizda(2,1)
5933 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5934 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5935 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5941 C Contribution from graph IV
5943 call transpose2(EE(1,1,itl),auxmat(1,1))
5944 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5945 vv(1)=pizda(1,1)+pizda(2,2)
5946 vv(2)=pizda(2,1)-pizda(1,2)
5947 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5948 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5950 C Explicit gradient in virtual-dihedral angles.
5951 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5952 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5953 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5954 vv(1)=pizda(1,1)+pizda(2,2)
5955 vv(2)=pizda(2,1)-pizda(1,2)
5956 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5957 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5958 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5959 C Cartesian gradient
5963 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5965 vv(1)=pizda(1,1)+pizda(2,2)
5966 vv(2)=pizda(2,1)-pizda(1,2)
5967 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5968 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5969 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5975 C Antiparallel orientation
5976 C Contribution from graph III
5978 call transpose2(EUg(1,1,j),auxmat(1,1))
5979 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5980 vv(1)=pizda(1,1)-pizda(2,2)
5981 vv(2)=pizda(1,2)+pizda(2,1)
5982 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
5983 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5985 C Explicit gradient in virtual-dihedral angles.
5986 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5987 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
5988 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
5989 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5990 vv(1)=pizda(1,1)-pizda(2,2)
5991 vv(2)=pizda(1,2)+pizda(2,1)
5992 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5993 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
5994 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
5995 call transpose2(EUgder(1,1,j),auxmat1(1,1))
5996 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5997 vv(1)=pizda(1,1)-pizda(2,2)
5998 vv(2)=pizda(1,2)+pizda(2,1)
5999 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6000 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6001 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6002 C Cartesian gradient
6006 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6008 vv(1)=pizda(1,1)-pizda(2,2)
6009 vv(2)=pizda(1,2)+pizda(2,1)
6010 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6011 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6012 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6018 C Contribution from graph IV
6020 call transpose2(EE(1,1,itj),auxmat(1,1))
6021 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6022 vv(1)=pizda(1,1)+pizda(2,2)
6023 vv(2)=pizda(2,1)-pizda(1,2)
6024 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6025 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6027 C Explicit gradient in virtual-dihedral angles.
6028 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6029 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6030 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6031 vv(1)=pizda(1,1)+pizda(2,2)
6032 vv(2)=pizda(2,1)-pizda(1,2)
6033 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6034 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6035 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6036 C Cartesian gradient
6040 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6042 vv(1)=pizda(1,1)+pizda(2,2)
6043 vv(2)=pizda(2,1)-pizda(1,2)
6044 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6045 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6046 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6053 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6054 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6055 cd write (2,*) 'ijkl',i,j,k,l
6056 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6057 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6059 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6060 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6061 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6062 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6064 if (j.lt.nres-1) then
6071 if (l.lt.nres-1) then
6081 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6083 ggg1(ll)=eel5*g_contij(ll,1)
6084 ggg2(ll)=eel5*g_contij(ll,2)
6085 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6086 ghalf=0.5d0*ggg1(ll)
6088 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6089 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6090 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6091 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6092 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6093 ghalf=0.5d0*ggg2(ll)
6095 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6096 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6097 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6098 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6103 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6104 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6109 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6110 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6116 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6121 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6125 cd write (2,*) iii,g_corr5_loc(iii)
6129 cd write (2,*) 'ekont',ekont
6130 cd write (iout,*) 'eello5',ekont*eel5
6133 c--------------------------------------------------------------------------
6134 double precision function eello6(i,j,k,l,jj,kk)
6135 implicit real*8 (a-h,o-z)
6136 include 'DIMENSIONS'
6137 include 'sizesclu.dat'
6138 include 'COMMON.IOUNITS'
6139 include 'COMMON.CHAIN'
6140 include 'COMMON.DERIV'
6141 include 'COMMON.INTERACT'
6142 include 'COMMON.CONTACTS'
6143 include 'COMMON.TORSION'
6144 include 'COMMON.VAR'
6145 include 'COMMON.GEO'
6146 include 'COMMON.FFIELD'
6147 double precision ggg1(3),ggg2(3)
6148 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6153 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6161 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6162 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6166 derx(lll,kkk,iii)=0.0d0
6170 cd eij=facont_hb(jj,i)
6171 cd ekl=facont_hb(kk,k)
6177 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6178 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6179 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6180 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6181 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6182 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6184 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6185 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6186 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6187 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6188 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6189 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6193 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6195 C If turn contributions are considered, they will be handled separately.
6196 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6197 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6198 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6199 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6200 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6201 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6202 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6205 if (j.lt.nres-1) then
6212 if (l.lt.nres-1) then
6220 ggg1(ll)=eel6*g_contij(ll,1)
6221 ggg2(ll)=eel6*g_contij(ll,2)
6222 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6223 ghalf=0.5d0*ggg1(ll)
6225 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6226 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6227 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6228 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6229 ghalf=0.5d0*ggg2(ll)
6230 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6232 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6233 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6234 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6235 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6240 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6241 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6246 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6247 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6253 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6258 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6262 cd write (2,*) iii,g_corr6_loc(iii)
6266 cd write (2,*) 'ekont',ekont
6267 cd write (iout,*) 'eello6',ekont*eel6
6270 c--------------------------------------------------------------------------
6271 double precision function eello6_graph1(i,j,k,l,imat,swap)
6272 implicit real*8 (a-h,o-z)
6273 include 'DIMENSIONS'
6274 include 'sizesclu.dat'
6275 include 'COMMON.IOUNITS'
6276 include 'COMMON.CHAIN'
6277 include 'COMMON.DERIV'
6278 include 'COMMON.INTERACT'
6279 include 'COMMON.CONTACTS'
6280 include 'COMMON.TORSION'
6281 include 'COMMON.VAR'
6282 include 'COMMON.GEO'
6283 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6287 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6289 C Parallel Antiparallel C
6295 C \ j|/k\| / \ |/k\|l / C
6300 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6301 itk=itortyp(itype(k))
6302 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6303 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6304 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6305 call transpose2(EUgC(1,1,k),auxmat(1,1))
6306 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6307 vv1(1)=pizda1(1,1)-pizda1(2,2)
6308 vv1(2)=pizda1(1,2)+pizda1(2,1)
6309 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6310 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6311 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6312 s5=scalar2(vv(1),Dtobr2(1,i))
6313 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6314 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6315 if (.not. calc_grad) return
6316 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6317 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6318 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6319 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6320 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6321 & +scalar2(vv(1),Dtobr2der(1,i)))
6322 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6323 vv1(1)=pizda1(1,1)-pizda1(2,2)
6324 vv1(2)=pizda1(1,2)+pizda1(2,1)
6325 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6326 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6328 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6329 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6330 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6331 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6332 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6334 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6335 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6336 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6337 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6338 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6340 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6341 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6342 vv1(1)=pizda1(1,1)-pizda1(2,2)
6343 vv1(2)=pizda1(1,2)+pizda1(2,1)
6344 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6345 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6346 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6347 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6356 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6357 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6358 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6359 call transpose2(EUgC(1,1,k),auxmat(1,1))
6360 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6362 vv1(1)=pizda1(1,1)-pizda1(2,2)
6363 vv1(2)=pizda1(1,2)+pizda1(2,1)
6364 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6365 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6366 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6367 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6368 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6369 s5=scalar2(vv(1),Dtobr2(1,i))
6370 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6376 c----------------------------------------------------------------------------
6377 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6378 implicit real*8 (a-h,o-z)
6379 include 'DIMENSIONS'
6380 include 'sizesclu.dat'
6381 include 'COMMON.IOUNITS'
6382 include 'COMMON.CHAIN'
6383 include 'COMMON.DERIV'
6384 include 'COMMON.INTERACT'
6385 include 'COMMON.CONTACTS'
6386 include 'COMMON.TORSION'
6387 include 'COMMON.VAR'
6388 include 'COMMON.GEO'
6390 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6391 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6394 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6396 C Parallel Antiparallel C
6402 C \ j|/k\| \ |/k\|l C
6407 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6408 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6409 C AL 7/4/01 s1 would occur in the sixth-order moment,
6410 C but not in a cluster cumulant
6412 s1=dip(1,jj,i)*dip(1,kk,k)
6414 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6415 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6416 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6417 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6418 call transpose2(EUg(1,1,k),auxmat(1,1))
6419 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6420 vv(1)=pizda(1,1)-pizda(2,2)
6421 vv(2)=pizda(1,2)+pizda(2,1)
6422 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6423 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6425 eello6_graph2=-(s1+s2+s3+s4)
6427 eello6_graph2=-(s2+s3+s4)
6430 if (.not. calc_grad) return
6431 C Derivatives in gamma(i-1)
6434 s1=dipderg(1,jj,i)*dip(1,kk,k)
6436 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6437 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6438 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6439 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6441 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6443 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6445 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6447 C Derivatives in gamma(k-1)
6449 s1=dip(1,jj,i)*dipderg(1,kk,k)
6451 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6452 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6453 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6454 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6455 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6456 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6457 vv(1)=pizda(1,1)-pizda(2,2)
6458 vv(2)=pizda(1,2)+pizda(2,1)
6459 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6461 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6463 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6465 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6466 C Derivatives in gamma(j-1) or gamma(l-1)
6469 s1=dipderg(3,jj,i)*dip(1,kk,k)
6471 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6472 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6473 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6474 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6475 vv(1)=pizda(1,1)-pizda(2,2)
6476 vv(2)=pizda(1,2)+pizda(2,1)
6477 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6480 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6482 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6485 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6486 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6488 C Derivatives in gamma(l-1) or gamma(j-1)
6491 s1=dip(1,jj,i)*dipderg(3,kk,k)
6493 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6494 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6495 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6496 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6497 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6498 vv(1)=pizda(1,1)-pizda(2,2)
6499 vv(2)=pizda(1,2)+pizda(2,1)
6500 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6503 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6505 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6508 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6509 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6511 C Cartesian derivatives.
6513 write (2,*) 'In eello6_graph2'
6515 write (2,*) 'iii=',iii
6517 write (2,*) 'kkk=',kkk
6519 write (2,'(3(2f10.5),5x)')
6520 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6530 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6532 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6535 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6537 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6538 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6540 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6541 call transpose2(EUg(1,1,k),auxmat(1,1))
6542 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6544 vv(1)=pizda(1,1)-pizda(2,2)
6545 vv(2)=pizda(1,2)+pizda(2,1)
6546 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6547 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6549 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6551 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6554 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6556 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6563 c----------------------------------------------------------------------------
6564 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6565 implicit real*8 (a-h,o-z)
6566 include 'DIMENSIONS'
6567 include 'sizesclu.dat'
6568 include 'COMMON.IOUNITS'
6569 include 'COMMON.CHAIN'
6570 include 'COMMON.DERIV'
6571 include 'COMMON.INTERACT'
6572 include 'COMMON.CONTACTS'
6573 include 'COMMON.TORSION'
6574 include 'COMMON.VAR'
6575 include 'COMMON.GEO'
6576 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6578 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6580 C Parallel Antiparallel C
6586 C j|/k\| / |/k\|l / C
6591 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6593 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6594 C energy moment and not to the cluster cumulant.
6595 iti=itortyp(itype(i))
6596 if (j.lt.nres-1) then
6597 itj1=itortyp(itype(j+1))
6601 itk=itortyp(itype(k))
6602 itk1=itortyp(itype(k+1))
6603 if (l.lt.nres-1) then
6604 itl1=itortyp(itype(l+1))
6609 s1=dip(4,jj,i)*dip(4,kk,k)
6611 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6612 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6613 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6614 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6615 call transpose2(EE(1,1,itk),auxmat(1,1))
6616 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6617 vv(1)=pizda(1,1)+pizda(2,2)
6618 vv(2)=pizda(2,1)-pizda(1,2)
6619 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6620 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6622 eello6_graph3=-(s1+s2+s3+s4)
6624 eello6_graph3=-(s2+s3+s4)
6627 if (.not. calc_grad) return
6628 C Derivatives in gamma(k-1)
6629 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6630 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6631 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6632 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6633 C Derivatives in gamma(l-1)
6634 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6635 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6636 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6637 vv(1)=pizda(1,1)+pizda(2,2)
6638 vv(2)=pizda(2,1)-pizda(1,2)
6639 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6640 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6641 C Cartesian derivatives.
6647 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6649 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6652 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6654 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6655 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6657 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6658 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6660 vv(1)=pizda(1,1)+pizda(2,2)
6661 vv(2)=pizda(2,1)-pizda(1,2)
6662 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6664 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6666 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6669 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6671 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6673 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6679 c----------------------------------------------------------------------------
6680 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6681 implicit real*8 (a-h,o-z)
6682 include 'DIMENSIONS'
6683 include 'sizesclu.dat'
6684 include 'COMMON.IOUNITS'
6685 include 'COMMON.CHAIN'
6686 include 'COMMON.DERIV'
6687 include 'COMMON.INTERACT'
6688 include 'COMMON.CONTACTS'
6689 include 'COMMON.TORSION'
6690 include 'COMMON.VAR'
6691 include 'COMMON.GEO'
6692 include 'COMMON.FFIELD'
6693 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6694 & auxvec1(2),auxmat1(2,2)
6696 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6698 C Parallel Antiparallel C
6704 C \ j|/k\| \ |/k\|l C
6709 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6711 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6712 C energy moment and not to the cluster cumulant.
6713 cd write (2,*) 'eello_graph4: wturn6',wturn6
6714 iti=itortyp(itype(i))
6715 itj=itortyp(itype(j))
6716 if (j.lt.nres-1) then
6717 itj1=itortyp(itype(j+1))
6721 itk=itortyp(itype(k))
6722 if (k.lt.nres-1) then
6723 itk1=itortyp(itype(k+1))
6727 itl=itortyp(itype(l))
6728 if (l.lt.nres-1) then
6729 itl1=itortyp(itype(l+1))
6733 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6734 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6735 cd & ' itl',itl,' itl1',itl1
6738 s1=dip(3,jj,i)*dip(3,kk,k)
6740 s1=dip(2,jj,j)*dip(2,kk,l)
6743 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6744 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6746 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6747 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6749 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6750 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6752 call transpose2(EUg(1,1,k),auxmat(1,1))
6753 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6754 vv(1)=pizda(1,1)-pizda(2,2)
6755 vv(2)=pizda(2,1)+pizda(1,2)
6756 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6757 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6759 eello6_graph4=-(s1+s2+s3+s4)
6761 eello6_graph4=-(s2+s3+s4)
6763 if (.not. calc_grad) return
6764 C Derivatives in gamma(i-1)
6768 s1=dipderg(2,jj,i)*dip(3,kk,k)
6770 s1=dipderg(4,jj,j)*dip(2,kk,l)
6773 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6775 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6776 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6778 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6779 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6781 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6782 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6783 cd write (2,*) 'turn6 derivatives'
6785 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6787 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6791 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6793 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6797 C Derivatives in gamma(k-1)
6800 s1=dip(3,jj,i)*dipderg(2,kk,k)
6802 s1=dip(2,jj,j)*dipderg(4,kk,l)
6805 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6806 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6808 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6809 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6811 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6812 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6814 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6815 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6816 vv(1)=pizda(1,1)-pizda(2,2)
6817 vv(2)=pizda(2,1)+pizda(1,2)
6818 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6819 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6821 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6823 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6827 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6829 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6832 C Derivatives in gamma(j-1) or gamma(l-1)
6833 if (l.eq.j+1 .and. l.gt.1) then
6834 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6835 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6836 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6837 vv(1)=pizda(1,1)-pizda(2,2)
6838 vv(2)=pizda(2,1)+pizda(1,2)
6839 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6840 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6841 else if (j.gt.1) then
6842 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6843 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6844 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6845 vv(1)=pizda(1,1)-pizda(2,2)
6846 vv(2)=pizda(2,1)+pizda(1,2)
6847 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6848 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6849 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6851 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6854 C Cartesian derivatives.
6861 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6863 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6867 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6869 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6873 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6875 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6877 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6878 & b1(1,itj1),auxvec(1))
6879 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6881 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6882 & b1(1,itl1),auxvec(1))
6883 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6885 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6887 vv(1)=pizda(1,1)-pizda(2,2)
6888 vv(2)=pizda(2,1)+pizda(1,2)
6889 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6891 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6893 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6896 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6899 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6902 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6904 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6906 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6910 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6912 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6915 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6917 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6925 c----------------------------------------------------------------------------
6926 double precision function eello_turn6(i,jj,kk)
6927 implicit real*8 (a-h,o-z)
6928 include 'DIMENSIONS'
6929 include 'sizesclu.dat'
6930 include 'COMMON.IOUNITS'
6931 include 'COMMON.CHAIN'
6932 include 'COMMON.DERIV'
6933 include 'COMMON.INTERACT'
6934 include 'COMMON.CONTACTS'
6935 include 'COMMON.TORSION'
6936 include 'COMMON.VAR'
6937 include 'COMMON.GEO'
6938 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6939 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6941 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6942 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6943 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6944 C the respective energy moment and not to the cluster cumulant.
6949 iti=itortyp(itype(i))
6950 itk=itortyp(itype(k))
6951 itk1=itortyp(itype(k+1))
6952 itl=itortyp(itype(l))
6953 itj=itortyp(itype(j))
6954 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6955 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6956 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6961 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6963 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6967 derx_turn(lll,kkk,iii)=0.0d0
6974 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6976 cd write (2,*) 'eello6_5',eello6_5
6978 call transpose2(AEA(1,1,1),auxmat(1,1))
6979 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
6980 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
6981 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
6985 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
6986 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
6987 s2 = scalar2(b1(1,itk),vtemp1(1))
6989 call transpose2(AEA(1,1,2),atemp(1,1))
6990 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
6991 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
6992 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
6996 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
6997 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
6998 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7000 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7001 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7002 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7003 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7004 ss13 = scalar2(b1(1,itk),vtemp4(1))
7005 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7009 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7015 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7017 C Derivatives in gamma(i+2)
7019 call transpose2(AEA(1,1,1),auxmatd(1,1))
7020 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7021 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7022 call transpose2(AEAderg(1,1,2),atempd(1,1))
7023 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7024 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7028 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7029 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7030 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7036 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7037 C Derivatives in gamma(i+3)
7039 call transpose2(AEA(1,1,1),auxmatd(1,1))
7040 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7041 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7042 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7046 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7047 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7048 s2d = scalar2(b1(1,itk),vtemp1d(1))
7050 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7051 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7053 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7055 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7056 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7057 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7067 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7068 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7070 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7071 & -0.5d0*ekont*(s2d+s12d)
7073 C Derivatives in gamma(i+4)
7074 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7075 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7076 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7078 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7079 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7080 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7090 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7092 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7094 C Derivatives in gamma(i+5)
7096 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7097 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7098 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7102 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7103 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7104 s2d = scalar2(b1(1,itk),vtemp1d(1))
7106 call transpose2(AEA(1,1,2),atempd(1,1))
7107 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7108 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7112 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7113 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7115 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7116 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7117 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7127 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7128 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7130 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7131 & -0.5d0*ekont*(s2d+s12d)
7133 C Cartesian derivatives
7138 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7139 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7140 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7144 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7145 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7147 s2d = scalar2(b1(1,itk),vtemp1d(1))
7149 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7150 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7151 s8d = -(atempd(1,1)+atempd(2,2))*
7152 & scalar2(cc(1,1,itl),vtemp2(1))
7156 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7158 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7159 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7166 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7169 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7173 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7174 & - 0.5d0*(s8d+s12d)
7176 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7185 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7187 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7188 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7189 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7190 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7191 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7193 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7194 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7195 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7199 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7200 cd & 16*eel_turn6_num
7202 if (j.lt.nres-1) then
7209 if (l.lt.nres-1) then
7217 ggg1(ll)=eel_turn6*g_contij(ll,1)
7218 ggg2(ll)=eel_turn6*g_contij(ll,2)
7219 ghalf=0.5d0*ggg1(ll)
7221 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7222 & +ekont*derx_turn(ll,2,1)
7223 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7224 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7225 & +ekont*derx_turn(ll,4,1)
7226 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7227 ghalf=0.5d0*ggg2(ll)
7229 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7230 & +ekont*derx_turn(ll,2,2)
7231 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7232 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7233 & +ekont*derx_turn(ll,4,2)
7234 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7239 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7244 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7250 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7255 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7259 cd write (2,*) iii,g_corr6_loc(iii)
7262 eello_turn6=ekont*eel_turn6
7263 cd write (2,*) 'ekont',ekont
7264 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7267 crc-------------------------------------------------
7268 SUBROUTINE MATVEC2(A1,V1,V2)
7269 implicit real*8 (a-h,o-z)
7270 include 'DIMENSIONS'
7271 DIMENSION A1(2,2),V1(2),V2(2)
7275 c 3 VI=VI+A1(I,K)*V1(K)
7279 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7280 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7285 C---------------------------------------
7286 SUBROUTINE MATMAT2(A1,A2,A3)
7287 implicit real*8 (a-h,o-z)
7288 include 'DIMENSIONS'
7289 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7290 c DIMENSION AI3(2,2)
7294 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7300 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7301 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7302 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7303 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7311 c-------------------------------------------------------------------------
7312 double precision function scalar2(u,v)
7314 double precision u(2),v(2)
7317 scalar2=u(1)*v(1)+u(2)*v(2)
7321 C-----------------------------------------------------------------------------
7323 subroutine transpose2(a,at)
7325 double precision a(2,2),at(2,2)
7332 c--------------------------------------------------------------------------
7333 subroutine transpose(n,a,at)
7336 double precision a(n,n),at(n,n)
7344 C---------------------------------------------------------------------------
7345 subroutine prodmat3(a1,a2,kk,transp,prod)
7348 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7350 crc double precision auxmat(2,2),prod_(2,2)
7353 crc call transpose2(kk(1,1),auxmat(1,1))
7354 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7355 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7357 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7358 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7359 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7360 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7361 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7362 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7363 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7364 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7367 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7368 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7370 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7371 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7372 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7373 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7374 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7375 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7376 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7377 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7380 c call transpose2(a2(1,1),a2t(1,1))
7383 crc print *,((prod_(i,j),i=1,2),j=1,2)
7384 crc print *,((prod(i,j),i=1,2),j=1,2)
7388 C-----------------------------------------------------------------------------
7389 double precision function scalar(u,v)
7391 double precision u(3),v(3)