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+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+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
155 cc if (dyn_ss) call dyn_set_nss
159 idumm=proc_proc(etot,i)
161 call proc_proc(etot,i)
163 if(i.eq.1)energia(0)=1.0d+99
169 C Sum up the components of the Cartesian gradient.
174 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
175 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
177 & wstrain*ghpbc(j,i)+
178 & wcorr*fact(3)*gradcorr(j,i)+
179 & wel_loc*fact(2)*gel_loc(j,i)+
180 & wturn3*fact(2)*gcorr3_turn(j,i)+
181 & wturn4*fact(3)*gcorr4_turn(j,i)+
182 & wcorr5*fact(4)*gradcorr5(j,i)+
183 & wcorr6*fact(5)*gradcorr6(j,i)+
184 & wturn6*fact(5)*gcorr6_turn(j,i)+
185 & wsccor*fact(2)*gsccorc(j,i)
186 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
188 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
193 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
194 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
196 & wcorr*fact(3)*gradcorr(j,i)+
197 & wel_loc*fact(2)*gel_loc(j,i)+
198 & wturn3*fact(2)*gcorr3_turn(j,i)+
199 & wturn4*fact(3)*gcorr4_turn(j,i)+
200 & wcorr5*fact(4)*gradcorr5(j,i)+
201 & wcorr6*fact(5)*gradcorr6(j,i)+
202 & wturn6*fact(5)*gcorr6_turn(j,i)+
203 & wsccor*fact(2)*gsccorc(j,i)
204 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
206 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
209 cd print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3),
210 cd & (gradc(k,i),k=1,3)
215 cd write (iout,*) i,g_corr5_loc(i)
216 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
217 & +wcorr5*fact(4)*g_corr5_loc(i)
218 & +wcorr6*fact(5)*g_corr6_loc(i)
219 & +wturn4*fact(3)*gel_loc_turn4(i)
220 & +wturn3*fact(2)*gel_loc_turn3(i)
221 & +wturn6*fact(5)*gel_loc_turn6(i)
222 & +wel_loc*fact(2)*gel_loc_loc(i)
223 & +wsccor*fact(1)*gsccor_loc(i)
226 cd call enerprint(energia(0),fact)
231 C------------------------------------------------------------------------
232 subroutine enerprint(energia,fact)
233 implicit real*8 (a-h,o-z)
235 include 'sizesclu.dat'
236 include 'COMMON.IOUNITS'
237 include 'COMMON.FFIELD'
238 include 'COMMON.SBRIDGE'
239 double precision energia(0:max_ene),fact(5)
243 evdw2=energia(2)+energia(17)
255 eello_turn3=energia(8)
256 eello_turn4=energia(9)
257 eello_turn6=energia(10)
264 edihcnstr=energia(20)
267 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
269 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
270 & etors_d,wtor_d*fact(2),ehpb,wstrain,
271 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
272 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
273 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
274 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
275 10 format (/'Virtual-chain energies:'//
276 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
277 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
278 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
279 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
280 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
281 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
282 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
283 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
284 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
285 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
286 & ' (SS bridges & dist. cnstr.)'/
287 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
288 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
289 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
290 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
291 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
292 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
293 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
294 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
295 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
296 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
297 & 'ETOT= ',1pE16.6,' (total)')
299 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
300 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
301 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
302 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
303 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
304 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
305 & edihcnstr,ebr*nss,etot
306 10 format (/'Virtual-chain energies:'//
307 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
308 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
309 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
310 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
311 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
312 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
313 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
314 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
315 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
316 & ' (SS bridges & dist. cnstr.)'/
317 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
318 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
319 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
320 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
321 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
322 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
323 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
324 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
325 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
326 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
327 & 'ETOT= ',1pE16.6,' (total)')
331 C-----------------------------------------------------------------------
334 C This subroutine calculates the interaction energy of nonbonded side chains
335 C assuming the LJ potential of interaction.
337 implicit real*8 (a-h,o-z)
339 include 'sizesclu.dat'
340 c include "DIMENSIONS.COMPAR"
341 parameter (accur=1.0d-10)
344 include 'COMMON.LOCAL'
345 include 'COMMON.CHAIN'
346 include 'COMMON.DERIV'
347 include 'COMMON.INTERACT'
348 include 'COMMON.TORSION'
349 include 'COMMON.SBRIDGE'
350 include 'COMMON.NAMES'
351 include 'COMMON.IOUNITS'
352 include 'COMMON.CONTACTS'
356 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
360 itypi1=iabs(itype(i+1))
367 C Calculate SC interaction energy.
370 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
371 cd & 'iend=',iend(i,iint)
372 do j=istart(i,iint),iend(i,iint)
377 C Change 12/1/95 to calculate four-body interactions
378 rij=xj*xj+yj*yj+zj*zj
380 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
381 eps0ij=eps(itypi,itypj)
383 e1=fac*fac*aa(itypi,itypj)
384 e2=fac*bb(itypi,itypj)
386 ij=icant(itypi,itypj)
387 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
388 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
389 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
390 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
391 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
392 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
396 C Calculate the components of the gradient in DC and X
398 fac=-rrij*(e1+evdwij)
403 gvdwx(k,i)=gvdwx(k,i)-gg(k)
404 gvdwx(k,j)=gvdwx(k,j)+gg(k)
408 gvdwc(l,k)=gvdwc(l,k)+gg(l)
413 C 12/1/95, revised on 5/20/97
415 C Calculate the contact function. The ith column of the array JCONT will
416 C contain the numbers of atoms that make contacts with the atom I (of numbers
417 C greater than I). The arrays FACONT and GACONT will contain the values of
418 C the contact function and its derivative.
420 C Uncomment next line, if the correlation interactions include EVDW explicitly.
421 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
422 C Uncomment next line, if the correlation interactions are contact function only
423 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
425 sigij=sigma(itypi,itypj)
426 r0ij=rs0(itypi,itypj)
428 C Check whether the SC's are not too far to make a contact.
431 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
432 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
434 if (fcont.gt.0.0D0) then
435 C If the SC-SC distance if close to sigma, apply spline.
436 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
437 cAdam & fcont1,fprimcont1)
438 cAdam fcont1=1.0d0-fcont1
439 cAdam if (fcont1.gt.0.0d0) then
440 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
441 cAdam fcont=fcont*fcont1
443 C Uncomment following 4 lines to have the geometric average of the epsilon0's
444 cga eps0ij=1.0d0/dsqrt(eps0ij)
446 cga gg(k)=gg(k)*eps0ij
448 cga eps0ij=-evdwij*eps0ij
449 C Uncomment for AL's type of SC correlation interactions.
451 num_conti=num_conti+1
453 facont(num_conti,i)=fcont*eps0ij
454 fprimcont=eps0ij*fprimcont/rij
456 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
457 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
458 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
459 C Uncomment following 3 lines for Skolnick's type of SC correlation.
460 gacont(1,num_conti,i)=-fprimcont*xj
461 gacont(2,num_conti,i)=-fprimcont*yj
462 gacont(3,num_conti,i)=-fprimcont*zj
463 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
464 cd write (iout,'(2i3,3f10.5)')
465 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
471 num_cont(i)=num_conti
476 gvdwc(j,i)=expon*gvdwc(j,i)
477 gvdwx(j,i)=expon*gvdwx(j,i)
481 C******************************************************************************
485 C To save time, the factor of EXPON has been extracted from ALL components
486 C of GVDWC and GRADX. Remember to multiply them by this factor before further
489 C******************************************************************************
492 C-----------------------------------------------------------------------------
493 subroutine eljk(evdw)
495 C This subroutine calculates the interaction energy of nonbonded side chains
496 C assuming the LJK potential of interaction.
498 implicit real*8 (a-h,o-z)
500 include 'sizesclu.dat'
501 c include "DIMENSIONS.COMPAR"
504 include 'COMMON.LOCAL'
505 include 'COMMON.CHAIN'
506 include 'COMMON.DERIV'
507 include 'COMMON.INTERACT'
508 include 'COMMON.IOUNITS'
509 include 'COMMON.NAMES'
514 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
518 itypi1=iabs(itype(i+1))
523 C Calculate SC interaction energy.
526 do j=istart(i,iint),iend(i,iint)
531 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
533 e_augm=augm(itypi,itypj)*fac_augm
536 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
537 fac=r_shift_inv**expon
538 e1=fac*fac*aa(itypi,itypj)
539 e2=fac*bb(itypi,itypj)
541 ij=icant(itypi,itypj)
542 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
543 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
544 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
545 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
546 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
547 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
548 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
552 C Calculate the components of the gradient in DC and X
554 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
559 gvdwx(k,i)=gvdwx(k,i)-gg(k)
560 gvdwx(k,j)=gvdwx(k,j)+gg(k)
564 gvdwc(l,k)=gvdwc(l,k)+gg(l)
574 gvdwc(j,i)=expon*gvdwc(j,i)
575 gvdwx(j,i)=expon*gvdwx(j,i)
581 C-----------------------------------------------------------------------------
584 C This subroutine calculates the interaction energy of nonbonded side chains
585 C assuming the Berne-Pechukas potential of interaction.
587 implicit real*8 (a-h,o-z)
589 include 'sizesclu.dat'
590 c include "DIMENSIONS.COMPAR"
593 include 'COMMON.LOCAL'
594 include 'COMMON.CHAIN'
595 include 'COMMON.DERIV'
596 include 'COMMON.NAMES'
597 include 'COMMON.INTERACT'
598 include 'COMMON.IOUNITS'
599 include 'COMMON.CALC'
601 c double precision rrsave(maxdim)
606 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
608 c if (icall.eq.0) then
616 itypi1=iabs(itype(i+1))
620 dxi=dc_norm(1,nres+i)
621 dyi=dc_norm(2,nres+i)
622 dzi=dc_norm(3,nres+i)
623 dsci_inv=vbld_inv(i+nres)
625 C Calculate SC interaction energy.
628 do j=istart(i,iint),iend(i,iint)
631 dscj_inv=vbld_inv(j+nres)
632 chi1=chi(itypi,itypj)
633 chi2=chi(itypj,itypi)
640 alf12=0.5D0*(alf1+alf2)
641 C For diagnostics only!!!
654 dxj=dc_norm(1,nres+j)
655 dyj=dc_norm(2,nres+j)
656 dzj=dc_norm(3,nres+j)
657 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
658 cd if (icall.eq.0) then
664 C Calculate the angle-dependent terms of energy & contributions to derivatives.
666 C Calculate whole angle-dependent part of epsilon and contributions
668 fac=(rrij*sigsq)**expon2
669 e1=fac*fac*aa(itypi,itypj)
670 e2=fac*bb(itypi,itypj)
671 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
672 eps2der=evdwij*eps3rt
673 eps3der=evdwij*eps2rt
674 evdwij=evdwij*eps2rt*eps3rt
675 ij=icant(itypi,itypj)
676 aux=eps1*eps2rt**2*eps3rt**2
680 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
681 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
682 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
683 cd & restyp(itypi),i,restyp(itypj),j,
684 cd & epsi,sigm,chi1,chi2,chip1,chip2,
685 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
686 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
689 C Calculate gradient components.
690 e1=e1*eps1*eps2rt**2*eps3rt**2
691 fac=-expon*(e1+evdwij)
694 C Calculate radial part of the gradient
698 C Calculate the angular part of the gradient and sum add the contributions
699 C to the appropriate components of the Cartesian gradient.
708 C-----------------------------------------------------------------------------
711 C This subroutine calculates the interaction energy of nonbonded side chains
712 C assuming the Gay-Berne potential of interaction.
714 implicit real*8 (a-h,o-z)
716 include 'sizesclu.dat'
717 c include "DIMENSIONS.COMPAR"
720 include 'COMMON.LOCAL'
721 include 'COMMON.CHAIN'
722 include 'COMMON.DERIV'
723 include 'COMMON.NAMES'
724 include 'COMMON.INTERACT'
725 include 'COMMON.IOUNITS'
726 include 'COMMON.CALC'
727 include 'COMMON.SBRIDGE'
733 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
736 c if (icall.gt.0) lprn=.true.
740 itypi1=iabs(itype(i+1))
744 dxi=dc_norm(1,nres+i)
745 dyi=dc_norm(2,nres+i)
746 dzi=dc_norm(3,nres+i)
747 dsci_inv=vbld_inv(i+nres)
749 C Calculate SC interaction energy.
752 do j=istart(i,iint),iend(i,iint)
753 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
754 call dyn_ssbond_ene(i,j,evdwij)
756 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
757 c & 'evdw',i,j,evdwij,' ss'
761 dscj_inv=vbld_inv(j+nres)
762 sig0ij=sigma(itypi,itypj)
763 chi1=chi(itypi,itypj)
764 chi2=chi(itypj,itypi)
771 alf12=0.5D0*(alf1+alf2)
772 C For diagnostics only!!!
785 dxj=dc_norm(1,nres+j)
786 dyj=dc_norm(2,nres+j)
787 dzj=dc_norm(3,nres+j)
788 c write (iout,*) i,j,xj,yj,zj
789 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
791 C Calculate angle-dependent terms of energy and contributions to their
795 sig=sig0ij*dsqrt(sigsq)
796 rij_shift=1.0D0/rij-sig+sig0ij
797 C I hate to put IF's in the loops, but here don't have another choice!!!!
798 if (rij_shift.le.0.0D0) then
803 c---------------------------------------------------------------
804 rij_shift=1.0D0/rij_shift
806 e1=fac*fac*aa(itypi,itypj)
807 e2=fac*bb(itypi,itypj)
808 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
809 eps2der=evdwij*eps3rt
810 eps3der=evdwij*eps2rt
811 evdwij=evdwij*eps2rt*eps3rt
813 ij=icant(itypi,itypj)
814 aux=eps1*eps2rt**2*eps3rt**2
815 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
816 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
817 c & aux*e2/eps(itypi,itypj)
819 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
820 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
821 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
822 & restyp(itypi),i,restyp(itypj),j,
823 & epsi,sigm,chi1,chi2,chip1,chip2,
824 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
825 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
829 C Calculate gradient components.
830 e1=e1*eps1*eps2rt**2*eps3rt**2
831 fac=-expon*(e1+evdwij)*rij_shift
834 C Calculate the radial part of the gradient
838 C Calculate angular part of the gradient.
847 C-----------------------------------------------------------------------------
848 subroutine egbv(evdw)
850 C This subroutine calculates the interaction energy of nonbonded side chains
851 C assuming the Gay-Berne-Vorobjev potential of interaction.
853 implicit real*8 (a-h,o-z)
855 include 'sizesclu.dat'
856 c include "DIMENSIONS.COMPAR"
859 include 'COMMON.LOCAL'
860 include 'COMMON.CHAIN'
861 include 'COMMON.DERIV'
862 include 'COMMON.NAMES'
863 include 'COMMON.INTERACT'
864 include 'COMMON.IOUNITS'
865 include 'COMMON.CALC'
866 include 'COMMON.SBRIDGE'
872 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
875 c if (icall.gt.0) lprn=.true.
879 itypi1=iabs(itype(i+1))
883 dxi=dc_norm(1,nres+i)
884 dyi=dc_norm(2,nres+i)
885 dzi=dc_norm(3,nres+i)
886 dsci_inv=vbld_inv(i+nres)
888 C Calculate SC interaction energy.
891 do j=istart(i,iint),iend(i,iint)
892 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
893 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
894 call dyn_ssbond_ene(i,j,evdwij)
896 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
897 c & 'evdw',i,j,evdwij,' ss'
901 dscj_inv=vbld_inv(j+nres)
902 sig0ij=sigma(itypi,itypj)
904 chi1=chi(itypi,itypj)
905 chi2=chi(itypj,itypi)
912 alf12=0.5D0*(alf1+alf2)
913 C For diagnostics only!!!
926 dxj=dc_norm(1,nres+j)
927 dyj=dc_norm(2,nres+j)
928 dzj=dc_norm(3,nres+j)
929 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
931 C Calculate angle-dependent terms of energy and contributions to their
935 sig=sig0ij*dsqrt(sigsq)
936 rij_shift=1.0D0/rij-sig+r0ij
937 C I hate to put IF's in the loops, but here don't have another choice!!!!
938 if (rij_shift.le.0.0D0) then
943 c---------------------------------------------------------------
944 rij_shift=1.0D0/rij_shift
946 e1=fac*fac*aa(itypi,itypj)
947 e2=fac*bb(itypi,itypj)
948 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
949 eps2der=evdwij*eps3rt
950 eps3der=evdwij*eps2rt
952 e_augm=augm(itypi,itypj)*fac_augm
953 evdwij=evdwij*eps2rt*eps3rt
954 evdw=evdw+evdwij+e_augm
955 ij=icant(itypi,itypj)
956 aux=eps1*eps2rt**2*eps3rt**2
958 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
959 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
960 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
961 c & restyp(itypi),i,restyp(itypj),j,
962 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
963 c & chi1,chi2,chip1,chip2,
964 c & eps1,eps2rt**2,eps3rt**2,
965 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
969 C Calculate gradient components.
970 e1=e1*eps1*eps2rt**2*eps3rt**2
971 fac=-expon*(e1+evdwij)*rij_shift
973 fac=rij*fac-2*expon*rrij*e_augm
974 C Calculate the radial part of the gradient
978 C Calculate angular part of the gradient.
987 C-----------------------------------------------------------------------------
988 subroutine sc_angular
989 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
990 C om12. Called by ebp, egb, and egbv.
992 include 'COMMON.CALC'
996 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
997 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
998 om12=dxi*dxj+dyi*dyj+dzi*dzj
1000 C Calculate eps1(om12) and its derivative in om12
1001 faceps1=1.0D0-om12*chiom12
1002 faceps1_inv=1.0D0/faceps1
1003 eps1=dsqrt(faceps1_inv)
1004 C Following variable is eps1*deps1/dom12
1005 eps1_om12=faceps1_inv*chiom12
1006 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1011 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1012 sigsq=1.0D0-facsig*faceps1_inv
1013 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1014 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1015 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1016 C Calculate eps2 and its derivatives in om1, om2, and om12.
1019 chipom12=chip12*om12
1020 facp=1.0D0-om12*chipom12
1022 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1023 C Following variable is the square root of eps2
1024 eps2rt=1.0D0-facp1*facp_inv
1025 C Following three variables are the derivatives of the square root of eps
1026 C in om1, om2, and om12.
1027 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1028 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1029 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1030 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1031 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1032 C Calculate whole angle-dependent part of epsilon and contributions
1033 C to its derivatives
1036 C----------------------------------------------------------------------------
1038 implicit real*8 (a-h,o-z)
1039 include 'DIMENSIONS'
1040 include 'sizesclu.dat'
1041 include 'COMMON.CHAIN'
1042 include 'COMMON.DERIV'
1043 include 'COMMON.CALC'
1044 double precision dcosom1(3),dcosom2(3)
1045 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1046 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1047 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1048 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1050 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1051 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1054 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1057 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1058 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1059 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1060 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1061 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1062 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1065 C Calculate the components of the gradient in DC and X
1069 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1074 c------------------------------------------------------------------------------
1075 subroutine vec_and_deriv
1076 implicit real*8 (a-h,o-z)
1077 include 'DIMENSIONS'
1078 include 'sizesclu.dat'
1079 include 'COMMON.IOUNITS'
1080 include 'COMMON.GEO'
1081 include 'COMMON.VAR'
1082 include 'COMMON.LOCAL'
1083 include 'COMMON.CHAIN'
1084 include 'COMMON.VECTORS'
1085 include 'COMMON.DERIV'
1086 include 'COMMON.INTERACT'
1087 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1088 C Compute the local reference systems. For reference system (i), the
1089 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1090 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1092 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1093 if (i.eq.nres-1) then
1094 C Case of the last full residue
1095 C Compute the Z-axis
1096 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1097 costh=dcos(pi-theta(nres))
1098 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1103 C Compute the derivatives of uz
1105 uzder(2,1,1)=-dc_norm(3,i-1)
1106 uzder(3,1,1)= dc_norm(2,i-1)
1107 uzder(1,2,1)= dc_norm(3,i-1)
1109 uzder(3,2,1)=-dc_norm(1,i-1)
1110 uzder(1,3,1)=-dc_norm(2,i-1)
1111 uzder(2,3,1)= dc_norm(1,i-1)
1114 uzder(2,1,2)= dc_norm(3,i)
1115 uzder(3,1,2)=-dc_norm(2,i)
1116 uzder(1,2,2)=-dc_norm(3,i)
1118 uzder(3,2,2)= dc_norm(1,i)
1119 uzder(1,3,2)= dc_norm(2,i)
1120 uzder(2,3,2)=-dc_norm(1,i)
1123 C Compute the Y-axis
1126 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1129 C Compute the derivatives of uy
1132 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1133 & -dc_norm(k,i)*dc_norm(j,i-1)
1134 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1136 uyder(j,j,1)=uyder(j,j,1)-costh
1137 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1142 uygrad(l,k,j,i)=uyder(l,k,j)
1143 uzgrad(l,k,j,i)=uzder(l,k,j)
1147 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1148 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1149 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1150 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1154 C Compute the Z-axis
1155 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1156 costh=dcos(pi-theta(i+2))
1157 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1162 C Compute the derivatives of uz
1164 uzder(2,1,1)=-dc_norm(3,i+1)
1165 uzder(3,1,1)= dc_norm(2,i+1)
1166 uzder(1,2,1)= dc_norm(3,i+1)
1168 uzder(3,2,1)=-dc_norm(1,i+1)
1169 uzder(1,3,1)=-dc_norm(2,i+1)
1170 uzder(2,3,1)= dc_norm(1,i+1)
1173 uzder(2,1,2)= dc_norm(3,i)
1174 uzder(3,1,2)=-dc_norm(2,i)
1175 uzder(1,2,2)=-dc_norm(3,i)
1177 uzder(3,2,2)= dc_norm(1,i)
1178 uzder(1,3,2)= dc_norm(2,i)
1179 uzder(2,3,2)=-dc_norm(1,i)
1182 C Compute the Y-axis
1185 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1188 C Compute the derivatives of uy
1191 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1192 & -dc_norm(k,i)*dc_norm(j,i+1)
1193 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1195 uyder(j,j,1)=uyder(j,j,1)-costh
1196 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1201 uygrad(l,k,j,i)=uyder(l,k,j)
1202 uzgrad(l,k,j,i)=uzder(l,k,j)
1206 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1207 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1208 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1209 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1215 vbld_inv_temp(1)=vbld_inv(i+1)
1216 if (i.lt.nres-1) then
1217 vbld_inv_temp(2)=vbld_inv(i+2)
1219 vbld_inv_temp(2)=vbld_inv(i)
1224 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1225 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1233 C-----------------------------------------------------------------------------
1234 subroutine vec_and_deriv_test
1235 implicit real*8 (a-h,o-z)
1236 include 'DIMENSIONS'
1237 include 'sizesclu.dat'
1238 include 'COMMON.IOUNITS'
1239 include 'COMMON.GEO'
1240 include 'COMMON.VAR'
1241 include 'COMMON.LOCAL'
1242 include 'COMMON.CHAIN'
1243 include 'COMMON.VECTORS'
1244 dimension uyder(3,3,2),uzder(3,3,2)
1245 C Compute the local reference systems. For reference system (i), the
1246 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1247 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1249 if (i.eq.nres-1) then
1250 C Case of the last full residue
1251 C Compute the Z-axis
1252 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1253 costh=dcos(pi-theta(nres))
1254 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1255 c write (iout,*) 'fac',fac,
1256 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1257 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1261 C Compute the derivatives of uz
1263 uzder(2,1,1)=-dc_norm(3,i-1)
1264 uzder(3,1,1)= dc_norm(2,i-1)
1265 uzder(1,2,1)= dc_norm(3,i-1)
1267 uzder(3,2,1)=-dc_norm(1,i-1)
1268 uzder(1,3,1)=-dc_norm(2,i-1)
1269 uzder(2,3,1)= dc_norm(1,i-1)
1272 uzder(2,1,2)= dc_norm(3,i)
1273 uzder(3,1,2)=-dc_norm(2,i)
1274 uzder(1,2,2)=-dc_norm(3,i)
1276 uzder(3,2,2)= dc_norm(1,i)
1277 uzder(1,3,2)= dc_norm(2,i)
1278 uzder(2,3,2)=-dc_norm(1,i)
1280 C Compute the Y-axis
1282 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1285 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1286 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1287 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1289 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1292 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1293 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1296 c write (iout,*) 'facy',facy,
1297 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1298 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1300 uy(k,i)=facy*uy(k,i)
1302 C Compute the derivatives of uy
1305 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1306 & -dc_norm(k,i)*dc_norm(j,i-1)
1307 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1309 c uyder(j,j,1)=uyder(j,j,1)-costh
1310 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1311 uyder(j,j,1)=uyder(j,j,1)
1312 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1313 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1319 uygrad(l,k,j,i)=uyder(l,k,j)
1320 uzgrad(l,k,j,i)=uzder(l,k,j)
1324 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1325 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1326 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1327 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1330 C Compute the Z-axis
1331 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1332 costh=dcos(pi-theta(i+2))
1333 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1334 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1338 C Compute the derivatives of uz
1340 uzder(2,1,1)=-dc_norm(3,i+1)
1341 uzder(3,1,1)= dc_norm(2,i+1)
1342 uzder(1,2,1)= dc_norm(3,i+1)
1344 uzder(3,2,1)=-dc_norm(1,i+1)
1345 uzder(1,3,1)=-dc_norm(2,i+1)
1346 uzder(2,3,1)= dc_norm(1,i+1)
1349 uzder(2,1,2)= dc_norm(3,i)
1350 uzder(3,1,2)=-dc_norm(2,i)
1351 uzder(1,2,2)=-dc_norm(3,i)
1353 uzder(3,2,2)= dc_norm(1,i)
1354 uzder(1,3,2)= dc_norm(2,i)
1355 uzder(2,3,2)=-dc_norm(1,i)
1357 C Compute the Y-axis
1359 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1360 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1361 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1363 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1366 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1367 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1370 c write (iout,*) 'facy',facy,
1371 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1372 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1374 uy(k,i)=facy*uy(k,i)
1376 C Compute the derivatives of uy
1379 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1380 & -dc_norm(k,i)*dc_norm(j,i+1)
1381 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1383 c uyder(j,j,1)=uyder(j,j,1)-costh
1384 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1385 uyder(j,j,1)=uyder(j,j,1)
1386 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1387 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1393 uygrad(l,k,j,i)=uyder(l,k,j)
1394 uzgrad(l,k,j,i)=uzder(l,k,j)
1398 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1399 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1400 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1401 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1408 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1409 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1416 C-----------------------------------------------------------------------------
1417 subroutine check_vecgrad
1418 implicit real*8 (a-h,o-z)
1419 include 'DIMENSIONS'
1420 include 'sizesclu.dat'
1421 include 'COMMON.IOUNITS'
1422 include 'COMMON.GEO'
1423 include 'COMMON.VAR'
1424 include 'COMMON.LOCAL'
1425 include 'COMMON.CHAIN'
1426 include 'COMMON.VECTORS'
1427 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1428 dimension uyt(3,maxres),uzt(3,maxres)
1429 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1430 double precision delta /1.0d-7/
1433 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1434 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1435 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1436 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1437 cd & (dc_norm(if90,i),if90=1,3)
1438 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1439 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1440 cd write(iout,'(a)')
1446 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1447 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1460 cd write (iout,*) 'i=',i
1462 erij(k)=dc_norm(k,i)
1466 dc_norm(k,i)=erij(k)
1468 dc_norm(j,i)=dc_norm(j,i)+delta
1469 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1471 c dc_norm(k,i)=dc_norm(k,i)/fac
1473 c write (iout,*) (dc_norm(k,i),k=1,3)
1474 c write (iout,*) (erij(k),k=1,3)
1477 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1478 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1479 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1480 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1482 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1483 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1484 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1487 dc_norm(k,i)=erij(k)
1490 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1491 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1492 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1493 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1494 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1495 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1496 cd write (iout,'(a)')
1501 C--------------------------------------------------------------------------
1502 subroutine set_matrices
1503 implicit real*8 (a-h,o-z)
1504 include 'DIMENSIONS'
1505 include 'sizesclu.dat'
1506 include 'COMMON.IOUNITS'
1507 include 'COMMON.GEO'
1508 include 'COMMON.VAR'
1509 include 'COMMON.LOCAL'
1510 include 'COMMON.CHAIN'
1511 include 'COMMON.DERIV'
1512 include 'COMMON.INTERACT'
1513 include 'COMMON.CONTACTS'
1514 include 'COMMON.TORSION'
1515 include 'COMMON.VECTORS'
1516 include 'COMMON.FFIELD'
1517 double precision auxvec(2),auxmat(2,2)
1519 C Compute the virtual-bond-torsional-angle dependent quantities needed
1520 C to calculate the el-loc multibody terms of various order.
1523 if (i .lt. nres+1) then
1560 if (i .gt. 3 .and. i .lt. nres+1) then
1561 obrot_der(1,i-2)=-sin1
1562 obrot_der(2,i-2)= cos1
1563 Ugder(1,1,i-2)= sin1
1564 Ugder(1,2,i-2)=-cos1
1565 Ugder(2,1,i-2)=-cos1
1566 Ugder(2,2,i-2)=-sin1
1569 obrot2_der(1,i-2)=-dwasin2
1570 obrot2_der(2,i-2)= dwacos2
1571 Ug2der(1,1,i-2)= dwasin2
1572 Ug2der(1,2,i-2)=-dwacos2
1573 Ug2der(2,1,i-2)=-dwacos2
1574 Ug2der(2,2,i-2)=-dwasin2
1576 obrot_der(1,i-2)=0.0d0
1577 obrot_der(2,i-2)=0.0d0
1578 Ugder(1,1,i-2)=0.0d0
1579 Ugder(1,2,i-2)=0.0d0
1580 Ugder(2,1,i-2)=0.0d0
1581 Ugder(2,2,i-2)=0.0d0
1582 obrot2_der(1,i-2)=0.0d0
1583 obrot2_der(2,i-2)=0.0d0
1584 Ug2der(1,1,i-2)=0.0d0
1585 Ug2der(1,2,i-2)=0.0d0
1586 Ug2der(2,1,i-2)=0.0d0
1587 Ug2der(2,2,i-2)=0.0d0
1589 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1590 iti = itortyp(itype(i-2))
1594 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1595 iti1 = itortyp(itype(i-1))
1599 cd write (iout,*) '*******i',i,' iti1',iti
1600 cd write (iout,*) 'b1',b1(:,iti)
1601 cd write (iout,*) 'b2',b2(:,iti)
1602 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1603 if (i .gt. iatel_s+2) then
1604 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1605 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1606 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1607 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1608 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1609 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1610 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1620 DtUg2(l,k,i-2)=0.0d0
1624 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1625 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1626 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1627 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1628 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1629 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1630 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1632 muder(k,i-2)=Ub2der(k,i-2)
1634 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1635 iti1 = itortyp(itype(i-1))
1640 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1642 C Vectors and matrices dependent on a single virtual-bond dihedral.
1643 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1644 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1645 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1646 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1647 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1648 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1649 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1650 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1651 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1652 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1653 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1655 C Matrices dependent on two consecutive virtual-bond dihedrals.
1656 C The order of matrices is from left to right.
1658 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1659 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1660 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1661 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1662 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1663 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1664 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1665 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1668 cd iti = itortyp(itype(i))
1671 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1672 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1677 C--------------------------------------------------------------------------
1678 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1680 C This subroutine calculates the average interaction energy and its gradient
1681 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1682 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1683 C The potential depends both on the distance of peptide-group centers and on
1684 C the orientation of the CA-CA virtual bonds.
1686 implicit real*8 (a-h,o-z)
1687 include 'DIMENSIONS'
1688 include 'sizesclu.dat'
1689 include 'COMMON.CONTROL'
1690 include 'COMMON.IOUNITS'
1691 include 'COMMON.GEO'
1692 include 'COMMON.VAR'
1693 include 'COMMON.LOCAL'
1694 include 'COMMON.CHAIN'
1695 include 'COMMON.DERIV'
1696 include 'COMMON.INTERACT'
1697 include 'COMMON.CONTACTS'
1698 include 'COMMON.TORSION'
1699 include 'COMMON.VECTORS'
1700 include 'COMMON.FFIELD'
1701 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1702 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1703 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1704 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1705 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1706 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1707 double precision scal_el /0.5d0/
1709 C 13-go grudnia roku pamietnego...
1710 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1711 & 0.0d0,1.0d0,0.0d0,
1712 & 0.0d0,0.0d0,1.0d0/
1713 cd write(iout,*) 'In EELEC'
1715 cd write(iout,*) 'Type',i
1716 cd write(iout,*) 'B1',B1(:,i)
1717 cd write(iout,*) 'B2',B2(:,i)
1718 cd write(iout,*) 'CC',CC(:,:,i)
1719 cd write(iout,*) 'DD',DD(:,:,i)
1720 cd write(iout,*) 'EE',EE(:,:,i)
1722 cd call check_vecgrad
1724 if (icheckgrad.eq.1) then
1726 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1728 dc_norm(k,i)=dc(k,i)*fac
1730 c write (iout,*) 'i',i,' fac',fac
1733 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1734 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1735 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1736 cd if (wel_loc.gt.0.0d0) then
1737 if (icheckgrad.eq.1) then
1738 call vec_and_deriv_test
1745 cd write (iout,*) 'i=',i
1747 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1750 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1751 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1764 cd print '(a)','Enter EELEC'
1765 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1767 gel_loc_loc(i)=0.0d0
1770 do i=iatel_s,iatel_e
1771 if (itel(i).eq.0) goto 1215
1775 dx_normi=dc_norm(1,i)
1776 dy_normi=dc_norm(2,i)
1777 dz_normi=dc_norm(3,i)
1778 xmedi=c(1,i)+0.5d0*dxi
1779 ymedi=c(2,i)+0.5d0*dyi
1780 zmedi=c(3,i)+0.5d0*dzi
1782 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1783 do j=ielstart(i),ielend(i)
1784 if (itel(j).eq.0) goto 1216
1788 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1789 aaa=app(iteli,itelj)
1790 bbb=bpp(iteli,itelj)
1791 C Diagnostics only!!!
1797 ael6i=ael6(iteli,itelj)
1798 ael3i=ael3(iteli,itelj)
1802 dx_normj=dc_norm(1,j)
1803 dy_normj=dc_norm(2,j)
1804 dz_normj=dc_norm(3,j)
1805 xj=c(1,j)+0.5D0*dxj-xmedi
1806 yj=c(2,j)+0.5D0*dyj-ymedi
1807 zj=c(3,j)+0.5D0*dzj-zmedi
1808 rij=xj*xj+yj*yj+zj*zj
1814 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1815 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1816 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1817 fac=cosa-3.0D0*cosb*cosg
1819 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1820 if (j.eq.i+2) ev1=scal_el*ev1
1825 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1828 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1829 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1830 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1833 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1834 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1835 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1836 cd & xmedi,ymedi,zmedi,xj,yj,zj
1838 C Calculate contributions to the Cartesian gradient.
1841 facvdw=-6*rrmij*(ev1+evdwij)
1842 facel=-3*rrmij*(el1+eesij)
1849 * Radial derivatives. First process both termini of the fragment (i,j)
1856 gelc(k,i)=gelc(k,i)+ghalf
1857 gelc(k,j)=gelc(k,j)+ghalf
1860 * Loop over residues i+1 thru j-1.
1864 gelc(l,k)=gelc(l,k)+ggg(l)
1872 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1873 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1876 * Loop over residues i+1 thru j-1.
1880 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1887 fac=-3*rrmij*(facvdw+facvdw+facel)
1893 * Radial derivatives. First process both termini of the fragment (i,j)
1900 gelc(k,i)=gelc(k,i)+ghalf
1901 gelc(k,j)=gelc(k,j)+ghalf
1904 * Loop over residues i+1 thru j-1.
1908 gelc(l,k)=gelc(l,k)+ggg(l)
1915 ecosa=2.0D0*fac3*fac1+fac4
1918 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1919 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1921 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1922 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1924 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1925 cd & (dcosg(k),k=1,3)
1927 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1931 gelc(k,i)=gelc(k,i)+ghalf
1932 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1933 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1934 gelc(k,j)=gelc(k,j)+ghalf
1935 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1936 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1940 gelc(l,k)=gelc(l,k)+ggg(l)
1945 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1946 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
1947 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
1949 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
1950 C energy of a peptide unit is assumed in the form of a second-order
1951 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
1952 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
1953 C are computed for EVERY pair of non-contiguous peptide groups.
1955 if (j.lt.nres-1) then
1966 muij(kkk)=mu(k,i)*mu(l,j)
1969 cd write (iout,*) 'EELEC: i',i,' j',j
1970 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
1971 cd write(iout,*) 'muij',muij
1972 ury=scalar(uy(1,i),erij)
1973 urz=scalar(uz(1,i),erij)
1974 vry=scalar(uy(1,j),erij)
1975 vrz=scalar(uz(1,j),erij)
1976 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
1977 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
1978 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
1979 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
1980 C For diagnostics only
1985 fac=dsqrt(-ael6i)*r3ij
1986 cd write (2,*) 'fac=',fac
1987 C For diagnostics only
1993 cd write (iout,'(4i5,4f10.5)')
1994 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
1995 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
1996 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
1997 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
1998 cd write (iout,'(4f10.5)')
1999 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2000 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2001 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2002 cd write (iout,'(2i3,9f10.5/)') i,j,
2003 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2005 C Derivatives of the elements of A in virtual-bond vectors
2006 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2013 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2014 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2015 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2016 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2017 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2018 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2019 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2020 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2021 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2022 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2023 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2024 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2034 C Compute radial contributions to the gradient
2056 C Add the contributions coming from er
2059 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2060 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2061 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2062 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2065 C Derivatives in DC(i)
2066 ghalf1=0.5d0*agg(k,1)
2067 ghalf2=0.5d0*agg(k,2)
2068 ghalf3=0.5d0*agg(k,3)
2069 ghalf4=0.5d0*agg(k,4)
2070 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2071 & -3.0d0*uryg(k,2)*vry)+ghalf1
2072 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2073 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2074 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2075 & -3.0d0*urzg(k,2)*vry)+ghalf3
2076 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2077 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2078 C Derivatives in DC(i+1)
2079 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2080 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2081 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2082 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2083 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2084 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2085 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2086 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2087 C Derivatives in DC(j)
2088 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2089 & -3.0d0*vryg(k,2)*ury)+ghalf1
2090 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2091 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2092 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2093 & -3.0d0*vryg(k,2)*urz)+ghalf3
2094 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2095 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2096 C Derivatives in DC(j+1) or DC(nres-1)
2097 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2098 & -3.0d0*vryg(k,3)*ury)
2099 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2100 & -3.0d0*vrzg(k,3)*ury)
2101 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2102 & -3.0d0*vryg(k,3)*urz)
2103 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2104 & -3.0d0*vrzg(k,3)*urz)
2109 C Derivatives in DC(i+1)
2110 cd aggi1(k,1)=agg(k,1)
2111 cd aggi1(k,2)=agg(k,2)
2112 cd aggi1(k,3)=agg(k,3)
2113 cd aggi1(k,4)=agg(k,4)
2114 C Derivatives in DC(j)
2119 C Derivatives in DC(j+1)
2124 if (j.eq.nres-1 .and. i.lt.j-2) then
2126 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2127 cd aggj1(k,l)=agg(k,l)
2133 C Check the loc-el terms by numerical integration
2143 aggi(k,l)=-aggi(k,l)
2144 aggi1(k,l)=-aggi1(k,l)
2145 aggj(k,l)=-aggj(k,l)
2146 aggj1(k,l)=-aggj1(k,l)
2149 if (j.lt.nres-1) then
2155 aggi(k,l)=-aggi(k,l)
2156 aggi1(k,l)=-aggi1(k,l)
2157 aggj(k,l)=-aggj(k,l)
2158 aggj1(k,l)=-aggj1(k,l)
2169 aggi(k,l)=-aggi(k,l)
2170 aggi1(k,l)=-aggi1(k,l)
2171 aggj(k,l)=-aggj(k,l)
2172 aggj1(k,l)=-aggj1(k,l)
2178 IF (wel_loc.gt.0.0d0) THEN
2179 C Contribution to the local-electrostatic energy coming from the i-j pair
2180 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2182 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2183 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2184 eel_loc=eel_loc+eel_loc_ij
2185 C Partial derivatives in virtual-bond dihedral angles gamma
2188 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2189 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2190 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2191 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2192 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2193 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2194 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2195 cd write(iout,*) 'agg ',agg
2196 cd write(iout,*) 'aggi ',aggi
2197 cd write(iout,*) 'aggi1',aggi1
2198 cd write(iout,*) 'aggj ',aggj
2199 cd write(iout,*) 'aggj1',aggj1
2201 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2203 ggg(l)=agg(l,1)*muij(1)+
2204 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2208 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2211 C Remaining derivatives of eello
2213 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2214 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2215 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2216 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2217 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2218 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2219 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2220 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2224 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2225 C Contributions from turns
2230 call eturn34(i,j,eello_turn3,eello_turn4)
2232 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2233 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2235 C Calculate the contact function. The ith column of the array JCONT will
2236 C contain the numbers of atoms that make contacts with the atom I (of numbers
2237 C greater than I). The arrays FACONT and GACONT will contain the values of
2238 C the contact function and its derivative.
2239 c r0ij=1.02D0*rpp(iteli,itelj)
2240 c r0ij=1.11D0*rpp(iteli,itelj)
2241 r0ij=2.20D0*rpp(iteli,itelj)
2242 c r0ij=1.55D0*rpp(iteli,itelj)
2243 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2244 if (fcont.gt.0.0D0) then
2245 num_conti=num_conti+1
2246 if (num_conti.gt.maxconts) then
2247 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2248 & ' will skip next contacts for this conf.'
2250 jcont_hb(num_conti,i)=j
2251 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2252 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2253 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2255 d_cont(num_conti,i)=rij
2256 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2257 C --- Electrostatic-interaction matrix ---
2258 a_chuj(1,1,num_conti,i)=a22
2259 a_chuj(1,2,num_conti,i)=a23
2260 a_chuj(2,1,num_conti,i)=a32
2261 a_chuj(2,2,num_conti,i)=a33
2262 C --- Gradient of rij
2264 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2267 c a_chuj(1,1,num_conti,i)=-0.61d0
2268 c a_chuj(1,2,num_conti,i)= 0.4d0
2269 c a_chuj(2,1,num_conti,i)= 0.65d0
2270 c a_chuj(2,2,num_conti,i)= 0.50d0
2271 c else if (i.eq.2) then
2272 c a_chuj(1,1,num_conti,i)= 0.0d0
2273 c a_chuj(1,2,num_conti,i)= 0.0d0
2274 c a_chuj(2,1,num_conti,i)= 0.0d0
2275 c a_chuj(2,2,num_conti,i)= 0.0d0
2277 C --- and its gradients
2278 cd write (iout,*) 'i',i,' j',j
2280 cd write (iout,*) 'iii 1 kkk',kkk
2281 cd write (iout,*) agg(kkk,:)
2284 cd write (iout,*) 'iii 2 kkk',kkk
2285 cd write (iout,*) aggi(kkk,:)
2288 cd write (iout,*) 'iii 3 kkk',kkk
2289 cd write (iout,*) aggi1(kkk,:)
2292 cd write (iout,*) 'iii 4 kkk',kkk
2293 cd write (iout,*) aggj(kkk,:)
2296 cd write (iout,*) 'iii 5 kkk',kkk
2297 cd write (iout,*) aggj1(kkk,:)
2304 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2305 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2306 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2307 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2308 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2310 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2316 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2317 C Calculate contact energies
2319 wij=cosa-3.0D0*cosb*cosg
2322 c fac3=dsqrt(-ael6i)/r0ij**3
2323 fac3=dsqrt(-ael6i)*r3ij
2324 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2325 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2327 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2328 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2329 C Diagnostics. Comment out or remove after debugging!
2330 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2331 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2332 c ees0m(num_conti,i)=0.0D0
2334 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2335 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2336 facont_hb(num_conti,i)=fcont
2338 C Angular derivatives of the contact function
2339 ees0pij1=fac3/ees0pij
2340 ees0mij1=fac3/ees0mij
2341 fac3p=-3.0D0*fac3*rrmij
2342 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2343 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2345 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2346 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2347 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2348 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2349 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2350 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2351 ecosap=ecosa1+ecosa2
2352 ecosbp=ecosb1+ecosb2
2353 ecosgp=ecosg1+ecosg2
2354 ecosam=ecosa1-ecosa2
2355 ecosbm=ecosb1-ecosb2
2356 ecosgm=ecosg1-ecosg2
2365 fprimcont=fprimcont/rij
2366 cd facont_hb(num_conti,i)=1.0D0
2367 C Following line is for diagnostics.
2370 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2371 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2374 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2375 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2377 gggp(1)=gggp(1)+ees0pijp*xj
2378 gggp(2)=gggp(2)+ees0pijp*yj
2379 gggp(3)=gggp(3)+ees0pijp*zj
2380 gggm(1)=gggm(1)+ees0mijp*xj
2381 gggm(2)=gggm(2)+ees0mijp*yj
2382 gggm(3)=gggm(3)+ees0mijp*zj
2383 C Derivatives due to the contact function
2384 gacont_hbr(1,num_conti,i)=fprimcont*xj
2385 gacont_hbr(2,num_conti,i)=fprimcont*yj
2386 gacont_hbr(3,num_conti,i)=fprimcont*zj
2388 ghalfp=0.5D0*gggp(k)
2389 ghalfm=0.5D0*gggm(k)
2390 gacontp_hb1(k,num_conti,i)=ghalfp
2391 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2392 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2393 gacontp_hb2(k,num_conti,i)=ghalfp
2394 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2395 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2396 gacontp_hb3(k,num_conti,i)=gggp(k)
2397 gacontm_hb1(k,num_conti,i)=ghalfm
2398 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2399 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2400 gacontm_hb2(k,num_conti,i)=ghalfm
2401 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2402 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2403 gacontm_hb3(k,num_conti,i)=gggm(k)
2406 C Diagnostics. Comment out or remove after debugging!
2408 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2409 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2410 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2411 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2412 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2413 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2416 endif ! num_conti.le.maxconts
2421 num_cont_hb(i)=num_conti
2425 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2426 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2428 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2429 ccc eel_loc=eel_loc+eello_turn3
2432 C-----------------------------------------------------------------------------
2433 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2434 C Third- and fourth-order contributions from turns
2435 implicit real*8 (a-h,o-z)
2436 include 'DIMENSIONS'
2437 include 'sizesclu.dat'
2438 include 'COMMON.IOUNITS'
2439 include 'COMMON.GEO'
2440 include 'COMMON.VAR'
2441 include 'COMMON.LOCAL'
2442 include 'COMMON.CHAIN'
2443 include 'COMMON.DERIV'
2444 include 'COMMON.INTERACT'
2445 include 'COMMON.CONTACTS'
2446 include 'COMMON.TORSION'
2447 include 'COMMON.VECTORS'
2448 include 'COMMON.FFIELD'
2450 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2451 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2452 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2453 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2454 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2455 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2457 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2459 C Third-order contributions
2466 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2467 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2468 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2469 call transpose2(auxmat(1,1),auxmat1(1,1))
2470 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2471 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2472 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2473 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2474 cd & ' eello_turn3_num',4*eello_turn3_num
2476 C Derivatives in gamma(i)
2477 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2478 call transpose2(auxmat2(1,1),pizda(1,1))
2479 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2480 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2481 C Derivatives in gamma(i+1)
2482 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2483 call transpose2(auxmat2(1,1),pizda(1,1))
2484 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2485 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2486 & +0.5d0*(pizda(1,1)+pizda(2,2))
2487 C Cartesian derivatives
2489 a_temp(1,1)=aggi(l,1)
2490 a_temp(1,2)=aggi(l,2)
2491 a_temp(2,1)=aggi(l,3)
2492 a_temp(2,2)=aggi(l,4)
2493 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2494 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2495 & +0.5d0*(pizda(1,1)+pizda(2,2))
2496 a_temp(1,1)=aggi1(l,1)
2497 a_temp(1,2)=aggi1(l,2)
2498 a_temp(2,1)=aggi1(l,3)
2499 a_temp(2,2)=aggi1(l,4)
2500 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2501 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2502 & +0.5d0*(pizda(1,1)+pizda(2,2))
2503 a_temp(1,1)=aggj(l,1)
2504 a_temp(1,2)=aggj(l,2)
2505 a_temp(2,1)=aggj(l,3)
2506 a_temp(2,2)=aggj(l,4)
2507 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2508 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2509 & +0.5d0*(pizda(1,1)+pizda(2,2))
2510 a_temp(1,1)=aggj1(l,1)
2511 a_temp(1,2)=aggj1(l,2)
2512 a_temp(2,1)=aggj1(l,3)
2513 a_temp(2,2)=aggj1(l,4)
2514 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2515 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2516 & +0.5d0*(pizda(1,1)+pizda(2,2))
2519 else if (j.eq.i+3) then
2520 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2522 C Fourth-order contributions
2530 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2531 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2532 iti1=itortyp(itype(i+1))
2533 iti2=itortyp(itype(i+2))
2534 iti3=itortyp(itype(i+3))
2535 call transpose2(EUg(1,1,i+1),e1t(1,1))
2536 call transpose2(Eug(1,1,i+2),e2t(1,1))
2537 call transpose2(Eug(1,1,i+3),e3t(1,1))
2538 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2539 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2540 s1=scalar2(b1(1,iti2),auxvec(1))
2541 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2542 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2543 s2=scalar2(b1(1,iti1),auxvec(1))
2544 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2545 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2546 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2547 eello_turn4=eello_turn4-(s1+s2+s3)
2548 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2549 cd & ' eello_turn4_num',8*eello_turn4_num
2550 C Derivatives in gamma(i)
2552 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2553 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2554 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2555 s1=scalar2(b1(1,iti2),auxvec(1))
2556 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2557 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2558 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2559 C Derivatives in gamma(i+1)
2560 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2561 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2562 s2=scalar2(b1(1,iti1),auxvec(1))
2563 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2564 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2565 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2566 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2567 C Derivatives in gamma(i+2)
2568 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2569 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2570 s1=scalar2(b1(1,iti2),auxvec(1))
2571 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2572 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2573 s2=scalar2(b1(1,iti1),auxvec(1))
2574 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2575 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2576 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2577 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2578 C Cartesian derivatives
2579 C Derivatives of this turn contributions in DC(i+2)
2580 if (j.lt.nres-1) then
2582 a_temp(1,1)=agg(l,1)
2583 a_temp(1,2)=agg(l,2)
2584 a_temp(2,1)=agg(l,3)
2585 a_temp(2,2)=agg(l,4)
2586 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2587 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2588 s1=scalar2(b1(1,iti2),auxvec(1))
2589 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2590 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2591 s2=scalar2(b1(1,iti1),auxvec(1))
2592 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2593 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2594 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2596 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2599 C Remaining derivatives of this turn contribution
2601 a_temp(1,1)=aggi(l,1)
2602 a_temp(1,2)=aggi(l,2)
2603 a_temp(2,1)=aggi(l,3)
2604 a_temp(2,2)=aggi(l,4)
2605 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2606 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2607 s1=scalar2(b1(1,iti2),auxvec(1))
2608 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2609 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2610 s2=scalar2(b1(1,iti1),auxvec(1))
2611 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2612 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2613 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2614 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2615 a_temp(1,1)=aggi1(l,1)
2616 a_temp(1,2)=aggi1(l,2)
2617 a_temp(2,1)=aggi1(l,3)
2618 a_temp(2,2)=aggi1(l,4)
2619 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2620 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2621 s1=scalar2(b1(1,iti2),auxvec(1))
2622 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2623 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2624 s2=scalar2(b1(1,iti1),auxvec(1))
2625 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2626 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2627 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2628 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2629 a_temp(1,1)=aggj(l,1)
2630 a_temp(1,2)=aggj(l,2)
2631 a_temp(2,1)=aggj(l,3)
2632 a_temp(2,2)=aggj(l,4)
2633 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2634 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2635 s1=scalar2(b1(1,iti2),auxvec(1))
2636 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2637 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2638 s2=scalar2(b1(1,iti1),auxvec(1))
2639 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2640 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2641 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2642 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2643 a_temp(1,1)=aggj1(l,1)
2644 a_temp(1,2)=aggj1(l,2)
2645 a_temp(2,1)=aggj1(l,3)
2646 a_temp(2,2)=aggj1(l,4)
2647 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2648 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2649 s1=scalar2(b1(1,iti2),auxvec(1))
2650 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2651 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2652 s2=scalar2(b1(1,iti1),auxvec(1))
2653 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2654 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2655 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2656 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2662 C-----------------------------------------------------------------------------
2663 subroutine vecpr(u,v,w)
2664 implicit real*8(a-h,o-z)
2665 dimension u(3),v(3),w(3)
2666 w(1)=u(2)*v(3)-u(3)*v(2)
2667 w(2)=-u(1)*v(3)+u(3)*v(1)
2668 w(3)=u(1)*v(2)-u(2)*v(1)
2671 C-----------------------------------------------------------------------------
2672 subroutine unormderiv(u,ugrad,unorm,ungrad)
2673 C This subroutine computes the derivatives of a normalized vector u, given
2674 C the derivatives computed without normalization conditions, ugrad. Returns
2677 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2678 double precision vec(3)
2679 double precision scalar
2681 c write (2,*) 'ugrad',ugrad
2684 vec(i)=scalar(ugrad(1,i),u(1))
2686 c write (2,*) 'vec',vec
2689 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2692 c write (2,*) 'ungrad',ungrad
2695 C-----------------------------------------------------------------------------
2696 subroutine escp(evdw2,evdw2_14)
2698 C This subroutine calculates the excluded-volume interaction energy between
2699 C peptide-group centers and side chains and its gradient in virtual-bond and
2700 C side-chain vectors.
2702 implicit real*8 (a-h,o-z)
2703 include 'DIMENSIONS'
2704 include 'sizesclu.dat'
2705 include 'COMMON.GEO'
2706 include 'COMMON.VAR'
2707 include 'COMMON.LOCAL'
2708 include 'COMMON.CHAIN'
2709 include 'COMMON.DERIV'
2710 include 'COMMON.INTERACT'
2711 include 'COMMON.FFIELD'
2712 include 'COMMON.IOUNITS'
2716 cd print '(a)','Enter ESCP'
2717 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2718 c & ' scal14',scal14
2719 do i=iatscp_s,iatscp_e
2721 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2722 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2723 if (iteli.eq.0) goto 1225
2724 xi=0.5D0*(c(1,i)+c(1,i+1))
2725 yi=0.5D0*(c(2,i)+c(2,i+1))
2726 zi=0.5D0*(c(3,i)+c(3,i+1))
2728 do iint=1,nscp_gr(i)
2730 do j=iscpstart(i,iint),iscpend(i,iint)
2731 itypj=iabs(itype(j))
2732 C Uncomment following three lines for SC-p interactions
2736 C Uncomment following three lines for Ca-p interactions
2740 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2742 e1=fac*fac*aad(itypj,iteli)
2743 e2=fac*bad(itypj,iteli)
2744 if (iabs(j-i) .le. 2) then
2747 evdw2_14=evdw2_14+e1+e2
2750 c write (iout,*) i,j,evdwij
2754 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2756 fac=-(evdwij+e1)*rrij
2761 cd write (iout,*) 'j<i'
2762 C Uncomment following three lines for SC-p interactions
2764 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2767 cd write (iout,*) 'j>i'
2770 C Uncomment following line for SC-p interactions
2771 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2775 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2779 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2780 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2783 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2793 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2794 gradx_scp(j,i)=expon*gradx_scp(j,i)
2797 C******************************************************************************
2801 C To save time the factor EXPON has been extracted from ALL components
2802 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2805 C******************************************************************************
2808 C--------------------------------------------------------------------------
2809 subroutine edis(ehpb)
2811 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2813 implicit real*8 (a-h,o-z)
2814 include 'DIMENSIONS'
2815 include 'COMMON.SBRIDGE'
2816 include 'COMMON.CHAIN'
2817 include 'COMMON.DERIV'
2818 include 'COMMON.VAR'
2819 include 'COMMON.INTERACT'
2820 include 'COMMON.IOUNITS'
2823 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2824 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2825 if (link_end.eq.0) return
2826 do i=link_start,link_end
2827 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2828 C CA-CA distance used in regularization of structure.
2831 C iii and jjj point to the residues for which the distance is assigned.
2832 if (ii.gt.nres) then
2839 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2840 c & dhpb(i),dhpb1(i),forcon(i)
2841 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2842 C distance and angle dependent SS bond potential.
2843 if (.not.dyn_ss .and. i.le.nss) then
2844 C 15/02/13 CC dynamic SSbond - additional check
2845 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2846 & iabs( itype(jjj)).eq.1) then
2847 call ssbond_ene(iii,jjj,eij)
2849 cd write (iout,*) "eij",eij
2851 else if (ii.gt.nres .and. jj.gt.nres) then
2852 c Restraints from contact prediction
2854 if (dhpb1(i).gt.0.0d0) then
2855 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2856 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2857 c write (iout,*) "beta nmr",
2858 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2862 C Get the force constant corresponding to this distance.
2864 C Calculate the contribution to energy.
2865 ehpb=ehpb+waga*rdis*rdis
2866 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2868 C Evaluate gradient.
2873 ggg(j)=fac*(c(j,jj)-c(j,ii))
2876 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2877 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2880 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2881 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2884 C Calculate the distance between the two points and its difference from the
2887 if (dhpb1(i).gt.0.0d0) then
2888 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2889 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2890 c write (iout,*) "alph nmr",
2891 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2894 C Get the force constant corresponding to this distance.
2896 C Calculate the contribution to energy.
2897 ehpb=ehpb+waga*rdis*rdis
2898 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2900 C Evaluate gradient.
2904 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2905 cd & ' waga=',waga,' fac=',fac
2907 ggg(j)=fac*(c(j,jj)-c(j,ii))
2909 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2910 C If this is a SC-SC distance, we need to calculate the contributions to the
2911 C Cartesian gradient in the SC vectors (ghpbx).
2914 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2915 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2919 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2920 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2927 C--------------------------------------------------------------------------
2928 subroutine ssbond_ene(i,j,eij)
2930 C Calculate the distance and angle dependent SS-bond potential energy
2931 C using a free-energy function derived based on RHF/6-31G** ab initio
2932 C calculations of diethyl disulfide.
2934 C A. Liwo and U. Kozlowska, 11/24/03
2936 implicit real*8 (a-h,o-z)
2937 include 'DIMENSIONS'
2938 include 'sizesclu.dat'
2939 include 'COMMON.SBRIDGE'
2940 include 'COMMON.CHAIN'
2941 include 'COMMON.DERIV'
2942 include 'COMMON.LOCAL'
2943 include 'COMMON.INTERACT'
2944 include 'COMMON.VAR'
2945 include 'COMMON.IOUNITS'
2946 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2947 itypi=iabs(itype(i))
2951 dxi=dc_norm(1,nres+i)
2952 dyi=dc_norm(2,nres+i)
2953 dzi=dc_norm(3,nres+i)
2954 dsci_inv=dsc_inv(itypi)
2955 itypj=iabs(itype(j))
2956 dscj_inv=dsc_inv(itypj)
2960 dxj=dc_norm(1,nres+j)
2961 dyj=dc_norm(2,nres+j)
2962 dzj=dc_norm(3,nres+j)
2963 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2968 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2969 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2970 om12=dxi*dxj+dyi*dyj+dzi*dzj
2972 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2973 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2979 deltat12=om2-om1+2.0d0
2981 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2982 & +akct*deltad*deltat12+ebr
2983 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2984 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2985 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2986 c & " deltat12",deltat12," eij",eij
2987 ed=2*akcm*deltad+akct*deltat12
2989 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
2990 eom1=-2*akth*deltat1-pom1-om2*pom2
2991 eom2= 2*akth*deltat2+pom1-om1*pom2
2994 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2997 ghpbx(k,i)=ghpbx(k,i)-gg(k)
2998 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
2999 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3000 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3003 C Calculate the components of the gradient in DC and X
3007 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3012 C--------------------------------------------------------------------------
3013 subroutine ebond(estr)
3015 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3017 implicit real*8 (a-h,o-z)
3018 include 'DIMENSIONS'
3019 include 'COMMON.LOCAL'
3020 include 'COMMON.GEO'
3021 include 'COMMON.INTERACT'
3022 include 'COMMON.DERIV'
3023 include 'COMMON.VAR'
3024 include 'COMMON.CHAIN'
3025 include 'COMMON.IOUNITS'
3026 include 'COMMON.NAMES'
3027 include 'COMMON.FFIELD'
3028 include 'COMMON.CONTROL'
3029 double precision u(3),ud(3)
3032 diff = vbld(i)-vbldp0
3033 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3036 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3041 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3048 diff=vbld(i+nres)-vbldsc0(1,iti)
3049 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3050 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3051 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3053 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3057 diff=vbld(i+nres)-vbldsc0(j,iti)
3058 ud(j)=aksc(j,iti)*diff
3059 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3073 uprod2=uprod2*u(k)*u(k)
3077 usumsqder=usumsqder+ud(j)*uprod2
3079 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3080 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3081 estr=estr+uprod/usum
3083 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3091 C--------------------------------------------------------------------------
3092 subroutine ebend(etheta)
3094 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3095 C angles gamma and its derivatives in consecutive thetas and gammas.
3097 implicit real*8 (a-h,o-z)
3098 include 'DIMENSIONS'
3099 include 'sizesclu.dat'
3100 include 'COMMON.LOCAL'
3101 include 'COMMON.GEO'
3102 include 'COMMON.INTERACT'
3103 include 'COMMON.DERIV'
3104 include 'COMMON.VAR'
3105 include 'COMMON.CHAIN'
3106 include 'COMMON.IOUNITS'
3107 include 'COMMON.NAMES'
3108 include 'COMMON.FFIELD'
3109 common /calcthet/ term1,term2,termm,diffak,ratak,
3110 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3111 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3112 double precision y(2),z(2)
3114 time11=dexp(-2*time)
3117 c write (iout,*) "nres",nres
3118 c write (*,'(a,i2)') 'EBEND ICG=',icg
3119 c write (iout,*) ithet_start,ithet_end
3120 do i=ithet_start,ithet_end
3121 C Zero the energy function and its derivative at 0 or pi.
3122 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3124 ichir1=isign(1,itype(i-2))
3125 ichir2=isign(1,itype(i))
3126 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3127 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3128 if (itype(i-1).eq.10) then
3129 itype1=isign(10,itype(i-2))
3130 ichir11=isign(1,itype(i-2))
3131 ichir12=isign(1,itype(i-2))
3132 itype2=isign(10,itype(i))
3133 ichir21=isign(1,itype(i))
3134 ichir22=isign(1,itype(i))
3136 c if (i.gt.ithet_start .and.
3137 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3138 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3146 c if (i.lt.nres .and. itel(i).ne.0) then
3158 call proc_proc(phii,icrc)
3159 if (icrc.eq.1) phii=150.0
3173 call proc_proc(phii1,icrc)
3174 if (icrc.eq.1) phii1=150.0
3186 C Calculate the "mean" value of theta from the part of the distribution
3187 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3188 C In following comments this theta will be referred to as t_c.
3189 thet_pred_mean=0.0d0
3191 athetk=athet(k,it,ichir1,ichir2)
3192 bthetk=bthet(k,it,ichir1,ichir2)
3194 athetk=athet(k,itype1,ichir11,ichir12)
3195 bthetk=bthet(k,itype2,ichir21,ichir22)
3197 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3199 c write (iout,*) "thet_pred_mean",thet_pred_mean
3200 dthett=thet_pred_mean*ssd
3201 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3202 c write (iout,*) "thet_pred_mean",thet_pred_mean
3203 C Derivatives of the "mean" values in gamma1 and gamma2.
3204 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3205 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3206 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3207 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3209 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3210 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3211 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3212 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3214 if (theta(i).gt.pi-delta) then
3215 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3217 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3218 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3219 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3221 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3223 else if (theta(i).lt.delta) then
3224 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3225 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3226 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3228 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3229 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3232 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3235 etheta=etheta+ethetai
3236 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3237 c & rad2deg*phii,rad2deg*phii1,ethetai
3238 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3239 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3240 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3243 C Ufff.... We've done all this!!!
3246 C---------------------------------------------------------------------------
3247 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3249 implicit real*8 (a-h,o-z)
3250 include 'DIMENSIONS'
3251 include 'COMMON.LOCAL'
3252 include 'COMMON.IOUNITS'
3253 common /calcthet/ term1,term2,termm,diffak,ratak,
3254 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3255 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3256 C Calculate the contributions to both Gaussian lobes.
3257 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3258 C The "polynomial part" of the "standard deviation" of this part of
3262 sig=sig*thet_pred_mean+polthet(j,it)
3264 C Derivative of the "interior part" of the "standard deviation of the"
3265 C gamma-dependent Gaussian lobe in t_c.
3266 sigtc=3*polthet(3,it)
3268 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3271 C Set the parameters of both Gaussian lobes of the distribution.
3272 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3273 fac=sig*sig+sigc0(it)
3276 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3277 sigsqtc=-4.0D0*sigcsq*sigtc
3278 c print *,i,sig,sigtc,sigsqtc
3279 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3280 sigtc=-sigtc/(fac*fac)
3281 C Following variable is sigma(t_c)**(-2)
3282 sigcsq=sigcsq*sigcsq
3284 sig0inv=1.0D0/sig0i**2
3285 delthec=thetai-thet_pred_mean
3286 delthe0=thetai-theta0i
3287 term1=-0.5D0*sigcsq*delthec*delthec
3288 term2=-0.5D0*sig0inv*delthe0*delthe0
3289 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3290 C NaNs in taking the logarithm. We extract the largest exponent which is added
3291 C to the energy (this being the log of the distribution) at the end of energy
3292 C term evaluation for this virtual-bond angle.
3293 if (term1.gt.term2) then
3295 term2=dexp(term2-termm)
3299 term1=dexp(term1-termm)
3302 C The ratio between the gamma-independent and gamma-dependent lobes of
3303 C the distribution is a Gaussian function of thet_pred_mean too.
3304 diffak=gthet(2,it)-thet_pred_mean
3305 ratak=diffak/gthet(3,it)**2
3306 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3307 C Let's differentiate it in thet_pred_mean NOW.
3309 C Now put together the distribution terms to make complete distribution.
3310 termexp=term1+ak*term2
3311 termpre=sigc+ak*sig0i
3312 C Contribution of the bending energy from this theta is just the -log of
3313 C the sum of the contributions from the two lobes and the pre-exponential
3314 C factor. Simple enough, isn't it?
3315 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3316 C NOW the derivatives!!!
3317 C 6/6/97 Take into account the deformation.
3318 E_theta=(delthec*sigcsq*term1
3319 & +ak*delthe0*sig0inv*term2)/termexp
3320 E_tc=((sigtc+aktc*sig0i)/termpre
3321 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3322 & aktc*term2)/termexp)
3325 c-----------------------------------------------------------------------------
3326 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3327 implicit real*8 (a-h,o-z)
3328 include 'DIMENSIONS'
3329 include 'COMMON.LOCAL'
3330 include 'COMMON.IOUNITS'
3331 common /calcthet/ term1,term2,termm,diffak,ratak,
3332 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3333 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3334 delthec=thetai-thet_pred_mean
3335 delthe0=thetai-theta0i
3336 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3337 t3 = thetai-thet_pred_mean
3341 t14 = t12+t6*sigsqtc
3343 t21 = thetai-theta0i
3349 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3350 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3351 & *(-t12*t9-ak*sig0inv*t27)
3355 C--------------------------------------------------------------------------
3356 subroutine ebend(etheta)
3358 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3359 C angles gamma and its derivatives in consecutive thetas and gammas.
3360 C ab initio-derived potentials from
3361 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3363 implicit real*8 (a-h,o-z)
3364 include 'DIMENSIONS'
3365 include 'COMMON.LOCAL'
3366 include 'COMMON.GEO'
3367 include 'COMMON.INTERACT'
3368 include 'COMMON.DERIV'
3369 include 'COMMON.VAR'
3370 include 'COMMON.CHAIN'
3371 include 'COMMON.IOUNITS'
3372 include 'COMMON.NAMES'
3373 include 'COMMON.FFIELD'
3374 include 'COMMON.CONTROL'
3375 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3376 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3377 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3378 & sinph1ph2(maxdouble,maxdouble)
3379 logical lprn /.false./, lprn1 /.false./
3381 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3382 do i=ithet_start,ithet_end
3383 if (itype(i-1).eq.ntyp1) cycle
3384 if (iabs(itype(i+1)).eq.20) iblock=2
3385 if (iabs(itype(i+1)).ne.20) iblock=1
3389 theti2=0.5d0*theta(i)
3390 ityp2=ithetyp((itype(i-1)))
3392 coskt(k)=dcos(k*theti2)
3393 sinkt(k)=dsin(k*theti2)
3398 if (phii.ne.phii) phii=150.0
3402 ityp1=ithetyp((itype(i-2)))
3404 cosph1(k)=dcos(k*phii)
3405 sinph1(k)=dsin(k*phii)
3418 if (phii1.ne.phii1) phii1=150.0
3423 ityp3=ithetyp((itype(i)))
3425 cosph2(k)=dcos(k*phii1)
3426 sinph2(k)=dsin(k*phii1)
3436 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3437 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3439 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3442 ccl=cosph1(l)*cosph2(k-l)
3443 ssl=sinph1(l)*sinph2(k-l)
3444 scl=sinph1(l)*cosph2(k-l)
3445 csl=cosph1(l)*sinph2(k-l)
3446 cosph1ph2(l,k)=ccl-ssl
3447 cosph1ph2(k,l)=ccl+ssl
3448 sinph1ph2(l,k)=scl+csl
3449 sinph1ph2(k,l)=scl-csl
3453 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3454 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3455 write (iout,*) "coskt and sinkt"
3457 write (iout,*) k,coskt(k),sinkt(k)
3461 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3462 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3465 & write (iout,*) "k",k," aathet"
3466 & ,aathet(k,ityp1,ityp2,ityp3,iblock),
3467 & " ethetai",ethetai
3470 write (iout,*) "cosph and sinph"
3472 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3474 write (iout,*) "cosph1ph2 and sinph2ph2"
3477 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3478 & sinph1ph2(l,k),sinph1ph2(k,l)
3481 write(iout,*) "ethetai",ethetai
3485 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3486 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3487 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3488 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3489 ethetai=ethetai+sinkt(m)*aux
3490 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3491 dephii=dephii+k*sinkt(m)*(
3492 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3493 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3494 dephii1=dephii1+k*sinkt(m)*(
3495 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3496 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3498 & write (iout,*) "m",m," k",k," bbthet",
3499 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3500 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3501 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3502 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3506 & write(iout,*) "ethetai",ethetai
3510 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3511 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3512 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3513 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3514 ethetai=ethetai+sinkt(m)*aux
3515 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3516 dephii=dephii+l*sinkt(m)*(
3517 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3518 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3519 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3520 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3521 dephii1=dephii1+(k-l)*sinkt(m)*(
3522 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3523 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3524 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3525 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3527 write (iout,*) "m",m," k",k," l",l," ffthet",
3528 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3529 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3530 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3531 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ethetai",
3533 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3534 & cosph1ph2(k,l)*sinkt(m),
3535 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3541 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3542 & i,theta(i)*rad2deg,phii*rad2deg,
3543 & phii1*rad2deg,ethetai
3544 etheta=etheta+ethetai
3545 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3546 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3547 gloc(nphi+i-2,icg)=wang*dethetai
3553 c-----------------------------------------------------------------------------
3554 subroutine esc(escloc)
3555 C Calculate the local energy of a side chain and its derivatives in the
3556 C corresponding virtual-bond valence angles THETA and the spherical angles
3558 implicit real*8 (a-h,o-z)
3559 include 'DIMENSIONS'
3560 include 'sizesclu.dat'
3561 include 'COMMON.GEO'
3562 include 'COMMON.LOCAL'
3563 include 'COMMON.VAR'
3564 include 'COMMON.INTERACT'
3565 include 'COMMON.DERIV'
3566 include 'COMMON.CHAIN'
3567 include 'COMMON.IOUNITS'
3568 include 'COMMON.NAMES'
3569 include 'COMMON.FFIELD'
3570 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3571 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3572 common /sccalc/ time11,time12,time112,theti,it,nlobit
3575 c write (iout,'(a)') 'ESC'
3576 do i=loc_start,loc_end
3578 if (it.eq.10) goto 1
3579 nlobit=nlob(iabs(it))
3580 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3581 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3582 theti=theta(i+1)-pipol
3586 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3588 if (x(2).gt.pi-delta) then
3592 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3594 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3595 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3597 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3598 & ddersc0(1),dersc(1))
3599 call spline2(x(2),pi-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),pi-delta,delta,esclocbi0,esclocbi1,
3606 & dersc0(2),esclocbi,dersc02)
3607 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3609 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
3621 c write (iout,*) escloci
3622 else if (x(2).lt.delta) then
3626 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3628 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3629 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3631 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3632 & ddersc0(1),dersc(1))
3633 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3634 & ddersc0(3),dersc(3))
3636 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3638 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3639 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3640 & dersc0(2),esclocbi,dersc02)
3641 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3646 call splinthet(x(2),0.5d0*delta,ss,ssd)
3648 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3650 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3651 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3653 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3654 c write (iout,*) escloci
3656 call enesc(x,escloci,dersc,ddummy,.false.)
3659 escloc=escloc+escloci
3660 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3662 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3664 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3665 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3670 C---------------------------------------------------------------------------
3671 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3672 implicit real*8 (a-h,o-z)
3673 include 'DIMENSIONS'
3674 include 'COMMON.GEO'
3675 include 'COMMON.LOCAL'
3676 include 'COMMON.IOUNITS'
3677 common /sccalc/ time11,time12,time112,theti,it,nlobit
3678 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3679 double precision contr(maxlob,-1:1)
3681 c write (iout,*) 'it=',it,' nlobit=',nlobit
3685 if (mixed) ddersc(j)=0.0d0
3689 C Because of periodicity of the dependence of the SC energy in omega we have
3690 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3691 C To avoid underflows, first compute & store the exponents.
3699 z(k)=x(k)-censc(k,j,it)
3704 Axk=Axk+gaussc(l,k,j,it)*z(l)
3710 expfac=expfac+Ax(k,j,iii)*z(k)
3718 C As in the case of ebend, we want to avoid underflows in exponentiation and
3719 C subsequent NaNs and INFs in energy calculation.
3720 C Find the largest exponent
3724 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3728 cd print *,'it=',it,' emin=',emin
3730 C Compute the contribution to SC energy and derivatives
3734 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3735 cd print *,'j=',j,' expfac=',expfac
3736 escloc_i=escloc_i+expfac
3738 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3742 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3743 & +gaussc(k,2,j,it))*expfac
3750 dersc(1)=dersc(1)/cos(theti)**2
3751 ddersc(1)=ddersc(1)/cos(theti)**2
3754 escloci=-(dlog(escloc_i)-emin)
3756 dersc(j)=dersc(j)/escloc_i
3760 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3765 C------------------------------------------------------------------------------
3766 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3767 implicit real*8 (a-h,o-z)
3768 include 'DIMENSIONS'
3769 include 'COMMON.GEO'
3770 include 'COMMON.LOCAL'
3771 include 'COMMON.IOUNITS'
3772 common /sccalc/ time11,time12,time112,theti,it,nlobit
3773 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3774 double precision contr(maxlob)
3785 z(k)=x(k)-censc(k,j,it)
3791 Axk=Axk+gaussc(l,k,j,it)*z(l)
3797 expfac=expfac+Ax(k,j)*z(k)
3802 C As in the case of ebend, we want to avoid underflows in exponentiation and
3803 C subsequent NaNs and INFs in energy calculation.
3804 C Find the largest exponent
3807 if (emin.gt.contr(j)) emin=contr(j)
3811 C Compute the contribution to SC energy and derivatives
3815 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3816 escloc_i=escloc_i+expfac
3818 dersc(k)=dersc(k)+Ax(k,j)*expfac
3820 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3821 & +gaussc(1,2,j,it))*expfac
3825 dersc(1)=dersc(1)/cos(theti)**2
3826 dersc12=dersc12/cos(theti)**2
3827 escloci=-(dlog(escloc_i)-emin)
3829 dersc(j)=dersc(j)/escloc_i
3831 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3835 c----------------------------------------------------------------------------------
3836 subroutine esc(escloc)
3837 C Calculate the local energy of a side chain and its derivatives in the
3838 C corresponding virtual-bond valence angles THETA and the spherical angles
3839 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3840 C added by Urszula Kozlowska. 07/11/2007
3842 implicit real*8 (a-h,o-z)
3843 include 'DIMENSIONS'
3844 include 'COMMON.GEO'
3845 include 'COMMON.LOCAL'
3846 include 'COMMON.VAR'
3847 include 'COMMON.SCROT'
3848 include 'COMMON.INTERACT'
3849 include 'COMMON.DERIV'
3850 include 'COMMON.CHAIN'
3851 include 'COMMON.IOUNITS'
3852 include 'COMMON.NAMES'
3853 include 'COMMON.FFIELD'
3854 include 'COMMON.CONTROL'
3855 include 'COMMON.VECTORS'
3856 double precision x_prime(3),y_prime(3),z_prime(3)
3857 & , sumene,dsc_i,dp2_i,x(65),
3858 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3859 & de_dxx,de_dyy,de_dzz,de_dt
3860 double precision s1_t,s1_6_t,s2_t,s2_6_t
3862 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3863 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3864 & dt_dCi(3),dt_dCi1(3)
3865 common /sccalc/ time11,time12,time112,theti,it,nlobit
3868 do i=loc_start,loc_end
3869 costtab(i+1) =dcos(theta(i+1))
3870 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3871 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3872 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3873 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3874 cosfac=dsqrt(cosfac2)
3875 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3876 sinfac=dsqrt(sinfac2)
3878 if (it.eq.10) goto 1
3880 C Compute the axes of tghe local cartesian coordinates system; store in
3881 c x_prime, y_prime and z_prime
3888 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3889 C & dc_norm(3,i+nres)
3891 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3892 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3895 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
3898 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3899 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3900 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3901 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3902 c & " xy",scalar(x_prime(1),y_prime(1)),
3903 c & " xz",scalar(x_prime(1),z_prime(1)),
3904 c & " yy",scalar(y_prime(1),y_prime(1)),
3905 c & " yz",scalar(y_prime(1),z_prime(1)),
3906 c & " zz",scalar(z_prime(1),z_prime(1))
3908 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3909 C to local coordinate system. Store in xx, yy, zz.
3915 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3916 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3917 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3918 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3926 C Compute the energy of the ith side cbain
3928 c write (2,*) "xx",xx," yy",yy," zz",zz
3931 x(j) = sc_parmin(j,it)
3934 Cc diagnostics - remove later
3936 yy1 = dsin(alph(2))*dcos(omeg(2))
3937 zz1 = -dsin(alph(2))*dsin(omeg(2))
3938 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3939 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3941 C," --- ", xx_w,yy_w,zz_w
3944 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3945 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3947 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3948 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3950 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3951 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3952 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3953 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3954 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3956 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3957 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3958 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3959 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3960 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3962 dsc_i = 0.743d0+x(61)
3964 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3965 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3966 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3967 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3968 s1=(1+x(63))/(0.1d0 + dscp1)
3969 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3970 s2=(1+x(65))/(0.1d0 + dscp2)
3971 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3972 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3973 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3974 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3976 c & dscp1,dscp2,sumene
3977 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3978 escloc = escloc + sumene
3979 c write (2,*) "escloc",escloc
3980 if (.not. calc_grad) goto 1
3983 C This section to check the numerical derivatives of the energy of ith side
3984 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3985 C #define DEBUG in the code to turn it on.
3987 write (2,*) "sumene =",sumene
3991 write (2,*) xx,yy,zz
3992 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3993 de_dxx_num=(sumenep-sumene)/aincr
3995 write (2,*) "xx+ sumene from enesc=",sumenep
3998 write (2,*) xx,yy,zz
3999 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4000 de_dyy_num=(sumenep-sumene)/aincr
4002 write (2,*) "yy+ sumene from enesc=",sumenep
4005 write (2,*) xx,yy,zz
4006 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4007 de_dzz_num=(sumenep-sumene)/aincr
4009 write (2,*) "zz+ sumene from enesc=",sumenep
4010 costsave=cost2tab(i+1)
4011 sintsave=sint2tab(i+1)
4012 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4013 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4014 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4015 de_dt_num=(sumenep-sumene)/aincr
4016 write (2,*) " t+ sumene from enesc=",sumenep
4017 cost2tab(i+1)=costsave
4018 sint2tab(i+1)=sintsave
4019 C End of diagnostics section.
4022 C Compute the gradient of esc
4024 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4025 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4026 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4027 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4028 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4029 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4030 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4031 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4032 pom1=(sumene3*sint2tab(i+1)+sumene1)
4033 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4034 pom2=(sumene4*cost2tab(i+1)+sumene2)
4035 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4036 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4037 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4038 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4040 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4041 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4042 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4044 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4045 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4046 & +(pom1+pom2)*pom_dx
4048 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4051 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4052 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4053 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4055 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4056 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4057 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4058 & +x(59)*zz**2 +x(60)*xx*zz
4059 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4060 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4061 & +(pom1-pom2)*pom_dy
4063 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4066 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4067 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4068 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4069 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4070 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4071 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4072 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4073 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4075 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4078 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4079 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4080 & +pom1*pom_dt1+pom2*pom_dt2
4082 write(2,*), "de_dt = ", de_dt,de_dt_num
4086 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4087 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4088 cosfac2xx=cosfac2*xx
4089 sinfac2yy=sinfac2*yy
4091 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4093 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4095 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4096 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4097 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4098 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4099 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4100 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4101 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4102 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4103 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4104 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4108 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4109 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4110 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4111 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4114 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4115 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4116 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4118 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4119 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4123 dXX_Ctab(k,i)=dXX_Ci(k)
4124 dXX_C1tab(k,i)=dXX_Ci1(k)
4125 dYY_Ctab(k,i)=dYY_Ci(k)
4126 dYY_C1tab(k,i)=dYY_Ci1(k)
4127 dZZ_Ctab(k,i)=dZZ_Ci(k)
4128 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4129 dXX_XYZtab(k,i)=dXX_XYZ(k)
4130 dYY_XYZtab(k,i)=dYY_XYZ(k)
4131 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4135 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4136 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4137 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4138 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4139 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4141 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4142 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4143 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4144 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4145 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4146 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4147 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4148 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4150 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4151 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4153 C to check gradient call subroutine check_grad
4160 c------------------------------------------------------------------------------
4161 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4163 C This procedure calculates two-body contact function g(rij) and its derivative:
4166 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4169 C where x=(rij-r0ij)/delta
4171 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4174 double precision rij,r0ij,eps0ij,fcont,fprimcont
4175 double precision x,x2,x4,delta
4179 if (x.lt.-1.0D0) then
4182 else if (x.le.1.0D0) then
4185 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4186 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4193 c------------------------------------------------------------------------------
4194 subroutine splinthet(theti,delta,ss,ssder)
4195 implicit real*8 (a-h,o-z)
4196 include 'DIMENSIONS'
4197 include 'sizesclu.dat'
4198 include 'COMMON.VAR'
4199 include 'COMMON.GEO'
4202 if (theti.gt.pipol) then
4203 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4205 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4210 c------------------------------------------------------------------------------
4211 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4213 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4214 double precision ksi,ksi2,ksi3,a1,a2,a3
4215 a1=fprim0*delta/(f1-f0)
4221 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4222 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4225 c------------------------------------------------------------------------------
4226 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4228 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4229 double precision ksi,ksi2,ksi3,a1,a2,a3
4234 a2=3*(f1x-f0x)-2*fprim0x*delta
4235 a3=fprim0x*delta-2*(f1x-f0x)
4236 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4239 C-----------------------------------------------------------------------------
4241 C-----------------------------------------------------------------------------
4242 subroutine etor(etors,edihcnstr,fact)
4243 implicit real*8 (a-h,o-z)
4244 include 'DIMENSIONS'
4245 include 'sizesclu.dat'
4246 include 'COMMON.VAR'
4247 include 'COMMON.GEO'
4248 include 'COMMON.LOCAL'
4249 include 'COMMON.TORSION'
4250 include 'COMMON.INTERACT'
4251 include 'COMMON.DERIV'
4252 include 'COMMON.CHAIN'
4253 include 'COMMON.NAMES'
4254 include 'COMMON.IOUNITS'
4255 include 'COMMON.FFIELD'
4256 include 'COMMON.TORCNSTR'
4258 C Set lprn=.true. for debugging
4262 do i=iphi_start,iphi_end
4263 itori=itortyp(itype(i-2))
4264 itori1=itortyp(itype(i-1))
4267 C Proline-Proline pair is a special case...
4268 if (itori.eq.3 .and. itori1.eq.3) then
4269 if (phii.gt.-dwapi3) then
4271 fac=1.0D0/(1.0D0-cosphi)
4272 etorsi=v1(1,3,3)*fac
4273 etorsi=etorsi+etorsi
4274 etors=etors+etorsi-v1(1,3,3)
4275 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4278 v1ij=v1(j+1,itori,itori1)
4279 v2ij=v2(j+1,itori,itori1)
4282 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4283 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4287 v1ij=v1(j,itori,itori1)
4288 v2ij=v2(j,itori,itori1)
4291 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4292 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4296 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4297 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4298 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4299 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4300 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4302 ! 6/20/98 - dihedral angle constraints
4305 itori=idih_constr(i)
4307 difi=pinorm(phii-phi0(i))
4308 if (difi.gt.drange(i)) then
4310 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4311 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4312 else if (difi.lt.-drange(i)) then
4314 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4315 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4317 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4318 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4320 write (iout,*) 'edihcnstr',edihcnstr
4323 c------------------------------------------------------------------------------
4325 subroutine etor(etors,edihcnstr,fact)
4326 implicit real*8 (a-h,o-z)
4327 include 'DIMENSIONS'
4328 include 'sizesclu.dat'
4329 include 'COMMON.VAR'
4330 include 'COMMON.GEO'
4331 include 'COMMON.LOCAL'
4332 include 'COMMON.TORSION'
4333 include 'COMMON.INTERACT'
4334 include 'COMMON.DERIV'
4335 include 'COMMON.CHAIN'
4336 include 'COMMON.NAMES'
4337 include 'COMMON.IOUNITS'
4338 include 'COMMON.FFIELD'
4339 include 'COMMON.TORCNSTR'
4341 C Set lprn=.true. for debugging
4345 do i=iphi_start,iphi_end
4346 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4347 if (iabs(itype(i)).eq.20) then
4352 itori=itortyp(itype(i-2))
4353 itori1=itortyp(itype(i-1))
4356 C Regular cosine and sine terms
4357 do j=1,nterm(itori,itori1,iblock)
4358 v1ij=v1(j,itori,itori1,iblock)
4359 v2ij=v2(j,itori,itori1,iblock)
4362 etors=etors+v1ij*cosphi+v2ij*sinphi
4363 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4367 C E = SUM ----------------------------------- - v1
4368 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4370 cosphi=dcos(0.5d0*phii)
4371 sinphi=dsin(0.5d0*phii)
4372 do j=1,nlor(itori,itori1,iblock)
4373 vl1ij=vlor1(j,itori,itori1)
4374 vl2ij=vlor2(j,itori,itori1)
4375 vl3ij=vlor3(j,itori,itori1)
4376 pom=vl2ij*cosphi+vl3ij*sinphi
4377 pom1=1.0d0/(pom*pom+1.0d0)
4378 etors=etors+vl1ij*pom1
4380 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4382 C Subtract the constant term
4383 etors=etors-v0(itori,itori1,iblock)
4385 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4386 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4387 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4388 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4389 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4392 ! 6/20/98 - dihedral angle constraints
4394 c write (iout,*) "Dihedral angle restraint energy"
4396 itori=idih_constr(i)
4398 difi=pinorm(phii-phi0(i))
4399 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
4400 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
4401 if (difi.gt.drange(i)) then
4403 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4404 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4405 c write (iout,*) 0.25d0*ftors*difi**4
4406 else if (difi.lt.-drange(i)) then
4408 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4409 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4410 c write (iout,*) 0.25d0*ftors*difi**4
4413 c write (iout,*) 'edihcnstr',edihcnstr
4416 c----------------------------------------------------------------------------
4417 subroutine etor_d(etors_d,fact2)
4418 C 6/23/01 Compute double torsional energy
4419 implicit real*8 (a-h,o-z)
4420 include 'DIMENSIONS'
4421 include 'sizesclu.dat'
4422 include 'COMMON.VAR'
4423 include 'COMMON.GEO'
4424 include 'COMMON.LOCAL'
4425 include 'COMMON.TORSION'
4426 include 'COMMON.INTERACT'
4427 include 'COMMON.DERIV'
4428 include 'COMMON.CHAIN'
4429 include 'COMMON.NAMES'
4430 include 'COMMON.IOUNITS'
4431 include 'COMMON.FFIELD'
4432 include 'COMMON.TORCNSTR'
4434 C Set lprn=.true. for debugging
4438 do i=iphi_start,iphi_end-1
4439 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4441 itori=itortyp(itype(i-2))
4442 itori1=itortyp(itype(i-1))
4443 itori2=itortyp(itype(i))
4449 if (iabs(itype(i+1)).eq.20) iblock=2
4450 C Regular cosine and sine terms
4451 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4452 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4453 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4454 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4455 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4456 cosphi1=dcos(j*phii)
4457 sinphi1=dsin(j*phii)
4458 cosphi2=dcos(j*phii1)
4459 sinphi2=dsin(j*phii1)
4460 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4461 & v2cij*cosphi2+v2sij*sinphi2
4462 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4463 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4465 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4467 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4468 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4469 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4470 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4471 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4472 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4473 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4474 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4475 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4476 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4477 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4478 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4479 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4480 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4483 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4484 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4490 c------------------------------------------------------------------------------
4491 subroutine eback_sc_corr(esccor,fact)
4492 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4493 c conformational states; temporarily implemented as differences
4494 c between UNRES torsional potentials (dependent on three types of
4495 c residues) and the torsional potentials dependent on all 20 types
4496 c of residues computed from AM1 energy surfaces of terminally-blocked
4497 c amino-acid residues.
4498 implicit real*8 (a-h,o-z)
4499 include 'DIMENSIONS'
4500 include 'COMMON.VAR'
4501 include 'COMMON.GEO'
4502 include 'COMMON.LOCAL'
4503 include 'COMMON.TORSION'
4504 include 'COMMON.SCCOR'
4505 include 'COMMON.INTERACT'
4506 include 'COMMON.DERIV'
4507 include 'COMMON.CHAIN'
4508 include 'COMMON.NAMES'
4509 include 'COMMON.IOUNITS'
4510 include 'COMMON.FFIELD'
4511 include 'COMMON.CONTROL'
4513 C Set lprn=.true. for debugging
4516 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4518 do i=itau_start,itau_end
4520 isccori=isccortyp(itype(i-2))
4521 isccori1=isccortyp(itype(i-1))
4523 cccc Added 9 May 2012
4524 cc Tauangle is torsional engle depending on the value of first digit
4525 c(see comment below)
4526 cc Omicron is flat angle depending on the value of first digit
4527 c(see comment below)
4530 do intertyp=1,3 !intertyp
4531 cc Added 09 May 2012 (Adasko)
4532 cc Intertyp means interaction type of backbone mainchain correlation:
4533 c 1 = SC...Ca...Ca...Ca
4534 c 2 = Ca...Ca...Ca...SC
4535 c 3 = SC...Ca...Ca...SCi
4537 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4538 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4539 & (itype(i-1).eq.ntyp1)))
4540 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4541 & .or.(itype(i-2).eq.ntyp1)))
4542 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4543 & (itype(i-1).eq.ntyp1)))) cycle
4544 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4545 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4547 do j=1,nterm_sccor(isccori,isccori1)
4548 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4549 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4550 cosphi=dcos(j*tauangle(intertyp,i))
4551 sinphi=dsin(j*tauangle(intertyp,i))
4552 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4553 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4555 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4556 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4557 c &gloc_sc(intertyp,i-3,icg)
4559 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4560 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4561 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4562 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4563 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4569 c------------------------------------------------------------------------------
4570 subroutine multibody(ecorr)
4571 C This subroutine calculates multi-body contributions to energy following
4572 C the idea of Skolnick et al. If side chains I and J make a contact and
4573 C at the same time side chains I+1 and J+1 make a contact, an extra
4574 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4575 implicit real*8 (a-h,o-z)
4576 include 'DIMENSIONS'
4577 include 'COMMON.IOUNITS'
4578 include 'COMMON.DERIV'
4579 include 'COMMON.INTERACT'
4580 include 'COMMON.CONTACTS'
4581 double precision gx(3),gx1(3)
4584 C Set lprn=.true. for debugging
4588 write (iout,'(a)') 'Contact function values:'
4590 write (iout,'(i2,20(1x,i2,f10.5))')
4591 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4606 num_conti=num_cont(i)
4607 num_conti1=num_cont(i1)
4612 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4613 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4614 cd & ' ishift=',ishift
4615 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4616 C The system gains extra energy.
4617 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4618 endif ! j1==j+-ishift
4627 c------------------------------------------------------------------------------
4628 double precision function esccorr(i,j,k,l,jj,kk)
4629 implicit real*8 (a-h,o-z)
4630 include 'DIMENSIONS'
4631 include 'COMMON.IOUNITS'
4632 include 'COMMON.DERIV'
4633 include 'COMMON.INTERACT'
4634 include 'COMMON.CONTACTS'
4635 double precision gx(3),gx1(3)
4640 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4641 C Calculate the multi-body contribution to energy.
4642 C Calculate multi-body contributions to the gradient.
4643 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4644 cd & k,l,(gacont(m,kk,k),m=1,3)
4646 gx(m) =ekl*gacont(m,jj,i)
4647 gx1(m)=eij*gacont(m,kk,k)
4648 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4649 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4650 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4651 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4655 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4660 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4666 c------------------------------------------------------------------------------
4668 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4669 implicit real*8 (a-h,o-z)
4670 include 'DIMENSIONS'
4671 integer dimen1,dimen2,atom,indx
4672 double precision buffer(dimen1,dimen2)
4673 double precision zapas
4674 common /contacts_hb/ zapas(3,20,maxres,7),
4675 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4676 & num_cont_hb(maxres),jcont_hb(20,maxres)
4677 num_kont=num_cont_hb(atom)
4681 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4684 buffer(i,indx+22)=facont_hb(i,atom)
4685 buffer(i,indx+23)=ees0p(i,atom)
4686 buffer(i,indx+24)=ees0m(i,atom)
4687 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4689 buffer(1,indx+26)=dfloat(num_kont)
4692 c------------------------------------------------------------------------------
4693 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4694 implicit real*8 (a-h,o-z)
4695 include 'DIMENSIONS'
4696 integer dimen1,dimen2,atom,indx
4697 double precision buffer(dimen1,dimen2)
4698 double precision zapas
4699 common /contacts_hb/ zapas(3,20,maxres,7),
4700 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4701 & num_cont_hb(maxres),jcont_hb(20,maxres)
4702 num_kont=buffer(1,indx+26)
4703 num_kont_old=num_cont_hb(atom)
4704 num_cont_hb(atom)=num_kont+num_kont_old
4709 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4712 facont_hb(ii,atom)=buffer(i,indx+22)
4713 ees0p(ii,atom)=buffer(i,indx+23)
4714 ees0m(ii,atom)=buffer(i,indx+24)
4715 jcont_hb(ii,atom)=buffer(i,indx+25)
4719 c------------------------------------------------------------------------------
4721 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4722 C This subroutine calculates multi-body contributions to hydrogen-bonding
4723 implicit real*8 (a-h,o-z)
4724 include 'DIMENSIONS'
4725 include 'sizesclu.dat'
4726 include 'COMMON.IOUNITS'
4728 include 'COMMON.INFO'
4730 include 'COMMON.FFIELD'
4731 include 'COMMON.DERIV'
4732 include 'COMMON.INTERACT'
4733 include 'COMMON.CONTACTS'
4735 parameter (max_cont=maxconts)
4736 parameter (max_dim=2*(8*3+2))
4737 parameter (msglen1=max_cont*max_dim*4)
4738 parameter (msglen2=2*msglen1)
4739 integer source,CorrelType,CorrelID,Error
4740 double precision buffer(max_cont,max_dim)
4742 double precision gx(3),gx1(3)
4745 C Set lprn=.true. for debugging
4750 if (fgProcs.le.1) goto 30
4752 write (iout,'(a)') 'Contact function values:'
4754 write (iout,'(2i3,50(1x,i2,f5.2))')
4755 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4756 & j=1,num_cont_hb(i))
4759 C Caution! Following code assumes that electrostatic interactions concerning
4760 C a given atom are split among at most two processors!
4770 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4773 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4774 if (MyRank.gt.0) then
4775 C Send correlation contributions to the preceding processor
4777 nn=num_cont_hb(iatel_s)
4778 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4779 cd write (iout,*) 'The BUFFER array:'
4781 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4783 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4785 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4786 C Clear the contacts of the atom passed to the neighboring processor
4787 nn=num_cont_hb(iatel_s+1)
4789 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4791 num_cont_hb(iatel_s)=0
4793 cd write (iout,*) 'Processor ',MyID,MyRank,
4794 cd & ' is sending correlation contribution to processor',MyID-1,
4795 cd & ' msglen=',msglen
4796 cd write (*,*) 'Processor ',MyID,MyRank,
4797 cd & ' is sending correlation contribution to processor',MyID-1,
4798 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4799 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4800 cd write (iout,*) 'Processor ',MyID,
4801 cd & ' has sent correlation contribution to processor',MyID-1,
4802 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4803 cd write (*,*) 'Processor ',MyID,
4804 cd & ' has sent correlation contribution to processor',MyID-1,
4805 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4807 endif ! (MyRank.gt.0)
4811 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4812 if (MyRank.lt.fgProcs-1) then
4813 C Receive correlation contributions from the next processor
4815 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4816 cd write (iout,*) 'Processor',MyID,
4817 cd & ' is receiving correlation contribution from processor',MyID+1,
4818 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4819 cd write (*,*) 'Processor',MyID,
4820 cd & ' is receiving correlation contribution from processor',MyID+1,
4821 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4823 do while (nbytes.le.0)
4824 call mp_probe(MyID+1,CorrelType,nbytes)
4826 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4827 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4828 cd write (iout,*) 'Processor',MyID,
4829 cd & ' has received correlation contribution from processor',MyID+1,
4830 cd & ' msglen=',msglen,' nbytes=',nbytes
4831 cd write (iout,*) 'The received BUFFER array:'
4833 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4835 if (msglen.eq.msglen1) then
4836 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4837 else if (msglen.eq.msglen2) then
4838 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4839 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4842 & 'ERROR!!!! message length changed while processing correlations.'
4844 & 'ERROR!!!! message length changed while processing correlations.'
4845 call mp_stopall(Error)
4846 endif ! msglen.eq.msglen1
4847 endif ! MyRank.lt.fgProcs-1
4854 write (iout,'(a)') 'Contact function values:'
4856 write (iout,'(2i3,50(1x,i2,f5.2))')
4857 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4858 & j=1,num_cont_hb(i))
4862 C Remove the loop below after debugging !!!
4869 C Calculate the local-electrostatic correlation terms
4870 do i=iatel_s,iatel_e+1
4872 num_conti=num_cont_hb(i)
4873 num_conti1=num_cont_hb(i+1)
4878 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4879 c & ' jj=',jj,' kk=',kk
4880 if (j1.eq.j+1 .or. j1.eq.j-1) then
4881 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4882 C The system gains extra energy.
4883 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4885 else if (j1.eq.j) then
4886 C Contacts I-J and I-(J+1) occur simultaneously.
4887 C The system loses extra energy.
4888 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4893 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4894 c & ' jj=',jj,' kk=',kk
4896 C Contacts I-J and (I+1)-J occur simultaneously.
4897 C The system loses extra energy.
4898 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4905 c------------------------------------------------------------------------------
4906 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4908 C This subroutine calculates multi-body contributions to hydrogen-bonding
4909 implicit real*8 (a-h,o-z)
4910 include 'DIMENSIONS'
4911 include 'sizesclu.dat'
4912 include 'COMMON.IOUNITS'
4914 include 'COMMON.INFO'
4916 include 'COMMON.FFIELD'
4917 include 'COMMON.DERIV'
4918 include 'COMMON.INTERACT'
4919 include 'COMMON.CONTACTS'
4921 parameter (max_cont=maxconts)
4922 parameter (max_dim=2*(8*3+2))
4923 parameter (msglen1=max_cont*max_dim*4)
4924 parameter (msglen2=2*msglen1)
4925 integer source,CorrelType,CorrelID,Error
4926 double precision buffer(max_cont,max_dim)
4928 double precision gx(3),gx1(3)
4931 C Set lprn=.true. for debugging
4938 if (fgProcs.le.1) goto 30
4940 write (iout,'(a)') 'Contact function values:'
4942 write (iout,'(2i3,50(1x,i2,f5.2))')
4943 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4944 & j=1,num_cont_hb(i))
4947 C Caution! Following code assumes that electrostatic interactions concerning
4948 C a given atom are split among at most two processors!
4958 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4961 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4962 if (MyRank.gt.0) then
4963 C Send correlation contributions to the preceding processor
4965 nn=num_cont_hb(iatel_s)
4966 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4967 cd write (iout,*) 'The BUFFER array:'
4969 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4971 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4973 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4974 C Clear the contacts of the atom passed to the neighboring processor
4975 nn=num_cont_hb(iatel_s+1)
4977 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4979 num_cont_hb(iatel_s)=0
4981 cd write (iout,*) 'Processor ',MyID,MyRank,
4982 cd & ' is sending correlation contribution to processor',MyID-1,
4983 cd & ' msglen=',msglen
4984 cd write (*,*) 'Processor ',MyID,MyRank,
4985 cd & ' is sending correlation contribution to processor',MyID-1,
4986 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4987 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4988 cd write (iout,*) 'Processor ',MyID,
4989 cd & ' has sent correlation contribution to processor',MyID-1,
4990 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4991 cd write (*,*) 'Processor ',MyID,
4992 cd & ' has sent correlation contribution to processor',MyID-1,
4993 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4995 endif ! (MyRank.gt.0)
4999 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5000 if (MyRank.lt.fgProcs-1) then
5001 C Receive correlation contributions from the next processor
5003 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5004 cd write (iout,*) 'Processor',MyID,
5005 cd & ' is receiving correlation contribution from processor',MyID+1,
5006 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5007 cd write (*,*) 'Processor',MyID,
5008 cd & ' is receiving correlation contribution from processor',MyID+1,
5009 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5011 do while (nbytes.le.0)
5012 call mp_probe(MyID+1,CorrelType,nbytes)
5014 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5015 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5016 cd write (iout,*) 'Processor',MyID,
5017 cd & ' has received correlation contribution from processor',MyID+1,
5018 cd & ' msglen=',msglen,' nbytes=',nbytes
5019 cd write (iout,*) 'The received BUFFER array:'
5021 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5023 if (msglen.eq.msglen1) then
5024 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5025 else if (msglen.eq.msglen2) then
5026 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5027 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5030 & 'ERROR!!!! message length changed while processing correlations.'
5032 & 'ERROR!!!! message length changed while processing correlations.'
5033 call mp_stopall(Error)
5034 endif ! msglen.eq.msglen1
5035 endif ! MyRank.lt.fgProcs-1
5042 write (iout,'(a)') 'Contact function values:'
5044 write (iout,'(2i3,50(1x,i2,f5.2))')
5045 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5046 & j=1,num_cont_hb(i))
5052 C Remove the loop below after debugging !!!
5059 C Calculate the dipole-dipole interaction energies
5060 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5061 do i=iatel_s,iatel_e+1
5062 num_conti=num_cont_hb(i)
5069 C Calculate the local-electrostatic correlation terms
5070 do i=iatel_s,iatel_e+1
5072 num_conti=num_cont_hb(i)
5073 num_conti1=num_cont_hb(i+1)
5078 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5079 c & ' jj=',jj,' kk=',kk
5080 if (j1.eq.j+1 .or. j1.eq.j-1) then
5081 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5082 C The system gains extra energy.
5084 sqd1=dsqrt(d_cont(jj,i))
5085 sqd2=dsqrt(d_cont(kk,i1))
5086 sred_geom = sqd1*sqd2
5087 IF (sred_geom.lt.cutoff_corr) THEN
5088 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5090 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5091 c & ' jj=',jj,' kk=',kk
5092 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5093 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5095 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5096 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5099 cd write (iout,*) 'sred_geom=',sred_geom,
5100 cd & ' ekont=',ekont,' fprim=',fprimcont
5101 call calc_eello(i,j,i+1,j1,jj,kk)
5102 if (wcorr4.gt.0.0d0)
5103 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5104 if (wcorr5.gt.0.0d0)
5105 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5106 c print *,"wcorr5",ecorr5
5107 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5108 cd write(2,*)'ijkl',i,j,i+1,j1
5109 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5110 & .or. wturn6.eq.0.0d0))then
5111 c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5112 c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5113 c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5114 c & 'ecorr6=',ecorr6, wcorr6
5115 cd write (iout,'(4e15.5)') sred_geom,
5116 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5117 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5118 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5119 else if (wturn6.gt.0.0d0
5120 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5121 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5122 eturn6=eturn6+eello_turn6(i,jj,kk)
5123 cd write (2,*) 'multibody_eello:eturn6',eturn6
5127 else if (j1.eq.j) then
5128 C Contacts I-J and I-(J+1) occur simultaneously.
5129 C The system loses extra energy.
5130 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5135 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5136 c & ' jj=',jj,' kk=',kk
5138 C Contacts I-J and (I+1)-J occur simultaneously.
5139 C The system loses extra energy.
5140 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5147 c------------------------------------------------------------------------------
5148 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5149 implicit real*8 (a-h,o-z)
5150 include 'DIMENSIONS'
5151 include 'COMMON.IOUNITS'
5152 include 'COMMON.DERIV'
5153 include 'COMMON.INTERACT'
5154 include 'COMMON.CONTACTS'
5155 double precision gx(3),gx1(3)
5165 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5166 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5167 C Following 4 lines for diagnostics.
5172 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5174 c write (iout,*)'Contacts have occurred for peptide groups',
5175 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5176 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5177 C Calculate the multi-body contribution to energy.
5178 ecorr=ecorr+ekont*ees
5180 C Calculate multi-body contributions to the gradient.
5182 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5183 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5184 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5185 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5186 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5187 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5188 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5189 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5190 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5191 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5192 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5193 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5194 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5195 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5199 gradcorr(ll,m)=gradcorr(ll,m)+
5200 & ees*ekl*gacont_hbr(ll,jj,i)-
5201 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5202 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5207 gradcorr(ll,m)=gradcorr(ll,m)+
5208 & ees*eij*gacont_hbr(ll,kk,k)-
5209 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5210 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5217 C---------------------------------------------------------------------------
5218 subroutine dipole(i,j,jj)
5219 implicit real*8 (a-h,o-z)
5220 include 'DIMENSIONS'
5221 include 'sizesclu.dat'
5222 include 'COMMON.IOUNITS'
5223 include 'COMMON.CHAIN'
5224 include 'COMMON.FFIELD'
5225 include 'COMMON.DERIV'
5226 include 'COMMON.INTERACT'
5227 include 'COMMON.CONTACTS'
5228 include 'COMMON.TORSION'
5229 include 'COMMON.VAR'
5230 include 'COMMON.GEO'
5231 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5233 iti1 = itortyp(itype(i+1))
5234 if (j.lt.nres-1) then
5235 itj1 = itortyp(itype(j+1))
5240 dipi(iii,1)=Ub2(iii,i)
5241 dipderi(iii)=Ub2der(iii,i)
5242 dipi(iii,2)=b1(iii,iti1)
5243 dipj(iii,1)=Ub2(iii,j)
5244 dipderj(iii)=Ub2der(iii,j)
5245 dipj(iii,2)=b1(iii,itj1)
5249 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5252 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5255 if (.not.calc_grad) return
5260 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5264 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5269 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5270 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5272 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5274 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5276 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5280 C---------------------------------------------------------------------------
5281 subroutine calc_eello(i,j,k,l,jj,kk)
5283 C This subroutine computes matrices and vectors needed to calculate
5284 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5286 implicit real*8 (a-h,o-z)
5287 include 'DIMENSIONS'
5288 include 'sizesclu.dat'
5289 include 'COMMON.IOUNITS'
5290 include 'COMMON.CHAIN'
5291 include 'COMMON.DERIV'
5292 include 'COMMON.INTERACT'
5293 include 'COMMON.CONTACTS'
5294 include 'COMMON.TORSION'
5295 include 'COMMON.VAR'
5296 include 'COMMON.GEO'
5297 include 'COMMON.FFIELD'
5298 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5299 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5302 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5303 cd & ' jj=',jj,' kk=',kk
5304 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5307 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5308 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5311 call transpose2(aa1(1,1),aa1t(1,1))
5312 call transpose2(aa2(1,1),aa2t(1,1))
5315 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5316 & aa1tder(1,1,lll,kkk))
5317 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5318 & aa2tder(1,1,lll,kkk))
5322 C parallel orientation of the two CA-CA-CA frames.
5324 iti=itortyp(itype(i))
5328 itk1=itortyp(itype(k+1))
5329 itj=itortyp(itype(j))
5330 if (l.lt.nres-1) then
5331 itl1=itortyp(itype(l+1))
5335 C A1 kernel(j+1) A2T
5337 cd write (iout,'(3f10.5,5x,3f10.5)')
5338 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5340 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5341 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5342 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5343 C Following matrices are needed only for 6-th order cumulants
5344 IF (wcorr6.gt.0.0d0) THEN
5345 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5346 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5347 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5348 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5349 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5350 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5351 & ADtEAderx(1,1,1,1,1,1))
5353 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5354 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5355 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5356 & ADtEA1derx(1,1,1,1,1,1))
5358 C End 6-th order cumulants
5361 cd write (2,*) 'In calc_eello6'
5363 cd write (2,*) 'iii=',iii
5365 cd write (2,*) 'kkk=',kkk
5367 cd write (2,'(3(2f10.5),5x)')
5368 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5373 call transpose2(EUgder(1,1,k),auxmat(1,1))
5374 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5375 call transpose2(EUg(1,1,k),auxmat(1,1))
5376 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5377 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5381 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5382 & EAEAderx(1,1,lll,kkk,iii,1))
5386 C A1T kernel(i+1) A2
5387 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5388 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5389 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5390 C Following matrices are needed only for 6-th order cumulants
5391 IF (wcorr6.gt.0.0d0) THEN
5392 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5393 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5394 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5395 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5396 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5397 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5398 & ADtEAderx(1,1,1,1,1,2))
5399 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5400 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5401 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5402 & ADtEA1derx(1,1,1,1,1,2))
5404 C End 6-th order cumulants
5405 call transpose2(EUgder(1,1,l),auxmat(1,1))
5406 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5407 call transpose2(EUg(1,1,l),auxmat(1,1))
5408 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5409 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5413 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5414 & EAEAderx(1,1,lll,kkk,iii,2))
5419 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5420 C They are needed only when the fifth- or the sixth-order cumulants are
5422 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5423 call transpose2(AEA(1,1,1),auxmat(1,1))
5424 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5425 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5426 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5427 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5428 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5429 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5430 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5431 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5432 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5433 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5434 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5435 call transpose2(AEA(1,1,2),auxmat(1,1))
5436 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5437 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5438 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5439 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5440 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5441 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5442 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5443 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5444 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5445 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5446 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5447 C Calculate the Cartesian derivatives of the vectors.
5451 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5452 call matvec2(auxmat(1,1),b1(1,iti),
5453 & AEAb1derx(1,lll,kkk,iii,1,1))
5454 call matvec2(auxmat(1,1),Ub2(1,i),
5455 & AEAb2derx(1,lll,kkk,iii,1,1))
5456 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5457 & AEAb1derx(1,lll,kkk,iii,2,1))
5458 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5459 & AEAb2derx(1,lll,kkk,iii,2,1))
5460 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5461 call matvec2(auxmat(1,1),b1(1,itj),
5462 & AEAb1derx(1,lll,kkk,iii,1,2))
5463 call matvec2(auxmat(1,1),Ub2(1,j),
5464 & AEAb2derx(1,lll,kkk,iii,1,2))
5465 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5466 & AEAb1derx(1,lll,kkk,iii,2,2))
5467 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5468 & AEAb2derx(1,lll,kkk,iii,2,2))
5475 C Antiparallel orientation of the two CA-CA-CA frames.
5477 iti=itortyp(itype(i))
5481 itk1=itortyp(itype(k+1))
5482 itl=itortyp(itype(l))
5483 itj=itortyp(itype(j))
5484 if (j.lt.nres-1) then
5485 itj1=itortyp(itype(j+1))
5489 C A2 kernel(j-1)T A1T
5490 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5491 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5492 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5493 C Following matrices are needed only for 6-th order cumulants
5494 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5495 & j.eq.i+4 .and. l.eq.i+3)) THEN
5496 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5497 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5498 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5499 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5500 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5501 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5502 & ADtEAderx(1,1,1,1,1,1))
5503 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5504 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5505 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5506 & ADtEA1derx(1,1,1,1,1,1))
5508 C End 6-th order cumulants
5509 call transpose2(EUgder(1,1,k),auxmat(1,1))
5510 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5511 call transpose2(EUg(1,1,k),auxmat(1,1))
5512 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5513 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5517 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5518 & EAEAderx(1,1,lll,kkk,iii,1))
5522 C A2T kernel(i+1)T A1
5523 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5524 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5525 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5526 C Following matrices are needed only for 6-th order cumulants
5527 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5528 & j.eq.i+4 .and. l.eq.i+3)) THEN
5529 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5530 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5531 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5532 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5533 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5534 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5535 & ADtEAderx(1,1,1,1,1,2))
5536 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5537 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5538 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5539 & ADtEA1derx(1,1,1,1,1,2))
5541 C End 6-th order cumulants
5542 call transpose2(EUgder(1,1,j),auxmat(1,1))
5543 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5544 call transpose2(EUg(1,1,j),auxmat(1,1))
5545 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5546 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5550 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5551 & EAEAderx(1,1,lll,kkk,iii,2))
5556 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5557 C They are needed only when the fifth- or the sixth-order cumulants are
5559 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5560 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5561 call transpose2(AEA(1,1,1),auxmat(1,1))
5562 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5563 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5564 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5565 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5566 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5567 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5568 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5569 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5570 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5571 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5572 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5573 call transpose2(AEA(1,1,2),auxmat(1,1))
5574 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5575 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5576 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5577 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5578 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5579 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5580 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5581 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5582 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5583 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5584 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5585 C Calculate the Cartesian derivatives of the vectors.
5589 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5590 call matvec2(auxmat(1,1),b1(1,iti),
5591 & AEAb1derx(1,lll,kkk,iii,1,1))
5592 call matvec2(auxmat(1,1),Ub2(1,i),
5593 & AEAb2derx(1,lll,kkk,iii,1,1))
5594 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5595 & AEAb1derx(1,lll,kkk,iii,2,1))
5596 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5597 & AEAb2derx(1,lll,kkk,iii,2,1))
5598 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5599 call matvec2(auxmat(1,1),b1(1,itl),
5600 & AEAb1derx(1,lll,kkk,iii,1,2))
5601 call matvec2(auxmat(1,1),Ub2(1,l),
5602 & AEAb2derx(1,lll,kkk,iii,1,2))
5603 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5604 & AEAb1derx(1,lll,kkk,iii,2,2))
5605 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5606 & AEAb2derx(1,lll,kkk,iii,2,2))
5615 C---------------------------------------------------------------------------
5616 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5617 & KK,KKderg,AKA,AKAderg,AKAderx)
5621 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5622 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5623 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5628 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5630 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5633 cd if (lprn) write (2,*) 'In kernel'
5635 cd if (lprn) write (2,*) 'kkk=',kkk
5637 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5638 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5640 cd write (2,*) 'lll=',lll
5641 cd write (2,*) 'iii=1'
5643 cd write (2,'(3(2f10.5),5x)')
5644 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5647 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5648 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5650 cd write (2,*) 'lll=',lll
5651 cd write (2,*) 'iii=2'
5653 cd write (2,'(3(2f10.5),5x)')
5654 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5661 C---------------------------------------------------------------------------
5662 double precision function eello4(i,j,k,l,jj,kk)
5663 implicit real*8 (a-h,o-z)
5664 include 'DIMENSIONS'
5665 include 'sizesclu.dat'
5666 include 'COMMON.IOUNITS'
5667 include 'COMMON.CHAIN'
5668 include 'COMMON.DERIV'
5669 include 'COMMON.INTERACT'
5670 include 'COMMON.CONTACTS'
5671 include 'COMMON.TORSION'
5672 include 'COMMON.VAR'
5673 include 'COMMON.GEO'
5674 double precision pizda(2,2),ggg1(3),ggg2(3)
5675 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5679 cd print *,'eello4:',i,j,k,l,jj,kk
5680 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5681 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5682 cold eij=facont_hb(jj,i)
5683 cold ekl=facont_hb(kk,k)
5685 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5687 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5688 gcorr_loc(k-1)=gcorr_loc(k-1)
5689 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5691 gcorr_loc(l-1)=gcorr_loc(l-1)
5692 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5694 gcorr_loc(j-1)=gcorr_loc(j-1)
5695 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5700 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5701 & -EAEAderx(2,2,lll,kkk,iii,1)
5702 cd derx(lll,kkk,iii)=0.0d0
5706 cd gcorr_loc(l-1)=0.0d0
5707 cd gcorr_loc(j-1)=0.0d0
5708 cd gcorr_loc(k-1)=0.0d0
5710 cd write (iout,*)'Contacts have occurred for peptide groups',
5711 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5712 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5713 if (j.lt.nres-1) then
5720 if (l.lt.nres-1) then
5728 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5729 ggg1(ll)=eel4*g_contij(ll,1)
5730 ggg2(ll)=eel4*g_contij(ll,2)
5731 ghalf=0.5d0*ggg1(ll)
5733 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5734 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5735 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5736 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5737 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5738 ghalf=0.5d0*ggg2(ll)
5740 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5741 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5742 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5743 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5748 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5749 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5754 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5755 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5761 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5766 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5770 cd write (2,*) iii,gcorr_loc(iii)
5774 cd write (2,*) 'ekont',ekont
5775 cd write (iout,*) 'eello4',ekont*eel4
5778 C---------------------------------------------------------------------------
5779 double precision function eello5(i,j,k,l,jj,kk)
5780 implicit real*8 (a-h,o-z)
5781 include 'DIMENSIONS'
5782 include 'sizesclu.dat'
5783 include 'COMMON.IOUNITS'
5784 include 'COMMON.CHAIN'
5785 include 'COMMON.DERIV'
5786 include 'COMMON.INTERACT'
5787 include 'COMMON.CONTACTS'
5788 include 'COMMON.TORSION'
5789 include 'COMMON.VAR'
5790 include 'COMMON.GEO'
5791 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5792 double precision ggg1(3),ggg2(3)
5793 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5798 C /l\ / \ \ / \ / \ / C
5799 C / \ / \ \ / \ / \ / C
5800 C j| o |l1 | o | o| o | | o |o C
5801 C \ |/k\| |/ \| / |/ \| |/ \| C
5802 C \i/ \ / \ / / \ / \ C
5804 C (I) (II) (III) (IV) C
5806 C eello5_1 eello5_2 eello5_3 eello5_4 C
5808 C Antiparallel chains C
5811 C /j\ / \ \ / \ / \ / C
5812 C / \ / \ \ / \ / \ / C
5813 C j1| o |l | o | o| o | | o |o C
5814 C \ |/k\| |/ \| / |/ \| |/ \| C
5815 C \i/ \ / \ / / \ / \ C
5817 C (I) (II) (III) (IV) C
5819 C eello5_1 eello5_2 eello5_3 eello5_4 C
5821 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5823 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5824 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5829 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5831 itk=itortyp(itype(k))
5832 itl=itortyp(itype(l))
5833 itj=itortyp(itype(j))
5838 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5839 cd & eel5_3_num,eel5_4_num)
5843 derx(lll,kkk,iii)=0.0d0
5847 cd eij=facont_hb(jj,i)
5848 cd ekl=facont_hb(kk,k)
5850 cd write (iout,*)'Contacts have occurred for peptide groups',
5851 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5853 C Contribution from the graph I.
5854 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5855 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5856 call transpose2(EUg(1,1,k),auxmat(1,1))
5857 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5858 vv(1)=pizda(1,1)-pizda(2,2)
5859 vv(2)=pizda(1,2)+pizda(2,1)
5860 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5861 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5863 C Explicit gradient in virtual-dihedral angles.
5864 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5865 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5866 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5867 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5868 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5869 vv(1)=pizda(1,1)-pizda(2,2)
5870 vv(2)=pizda(1,2)+pizda(2,1)
5871 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5872 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5873 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5874 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5875 vv(1)=pizda(1,1)-pizda(2,2)
5876 vv(2)=pizda(1,2)+pizda(2,1)
5878 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5879 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5880 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5882 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5883 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5884 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5886 C Cartesian gradient
5890 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5892 vv(1)=pizda(1,1)-pizda(2,2)
5893 vv(2)=pizda(1,2)+pizda(2,1)
5894 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5895 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5896 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5903 C Contribution from graph II
5904 call transpose2(EE(1,1,itk),auxmat(1,1))
5905 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5906 vv(1)=pizda(1,1)+pizda(2,2)
5907 vv(2)=pizda(2,1)-pizda(1,2)
5908 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5909 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5911 C Explicit gradient in virtual-dihedral angles.
5912 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5913 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5914 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5915 vv(1)=pizda(1,1)+pizda(2,2)
5916 vv(2)=pizda(2,1)-pizda(1,2)
5918 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5919 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5920 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5922 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5923 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5924 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5926 C Cartesian gradient
5930 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5932 vv(1)=pizda(1,1)+pizda(2,2)
5933 vv(2)=pizda(2,1)-pizda(1,2)
5934 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5935 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5936 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5945 C Parallel orientation
5946 C Contribution from graph III
5947 call transpose2(EUg(1,1,l),auxmat(1,1))
5948 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5949 vv(1)=pizda(1,1)-pizda(2,2)
5950 vv(2)=pizda(1,2)+pizda(2,1)
5951 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5952 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5954 C Explicit gradient in virtual-dihedral angles.
5955 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5956 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5957 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5958 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5959 vv(1)=pizda(1,1)-pizda(2,2)
5960 vv(2)=pizda(1,2)+pizda(2,1)
5961 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5962 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5963 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5964 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5965 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5966 vv(1)=pizda(1,1)-pizda(2,2)
5967 vv(2)=pizda(1,2)+pizda(2,1)
5968 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5969 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5970 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5971 C Cartesian gradient
5975 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5977 vv(1)=pizda(1,1)-pizda(2,2)
5978 vv(2)=pizda(1,2)+pizda(2,1)
5979 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5980 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5981 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5987 C Contribution from graph IV
5989 call transpose2(EE(1,1,itl),auxmat(1,1))
5990 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5991 vv(1)=pizda(1,1)+pizda(2,2)
5992 vv(2)=pizda(2,1)-pizda(1,2)
5993 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5994 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5996 C Explicit gradient in virtual-dihedral angles.
5997 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5998 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5999 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6000 vv(1)=pizda(1,1)+pizda(2,2)
6001 vv(2)=pizda(2,1)-pizda(1,2)
6002 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6003 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6004 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6005 C Cartesian gradient
6009 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6011 vv(1)=pizda(1,1)+pizda(2,2)
6012 vv(2)=pizda(2,1)-pizda(1,2)
6013 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6014 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6015 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6021 C Antiparallel orientation
6022 C Contribution from graph III
6024 call transpose2(EUg(1,1,j),auxmat(1,1))
6025 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6026 vv(1)=pizda(1,1)-pizda(2,2)
6027 vv(2)=pizda(1,2)+pizda(2,1)
6028 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6029 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6031 C Explicit gradient in virtual-dihedral angles.
6032 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6033 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6034 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6035 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6036 vv(1)=pizda(1,1)-pizda(2,2)
6037 vv(2)=pizda(1,2)+pizda(2,1)
6038 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6039 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6040 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6041 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6042 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6043 vv(1)=pizda(1,1)-pizda(2,2)
6044 vv(2)=pizda(1,2)+pizda(2,1)
6045 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6046 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6047 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6048 C Cartesian gradient
6052 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6054 vv(1)=pizda(1,1)-pizda(2,2)
6055 vv(2)=pizda(1,2)+pizda(2,1)
6056 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6057 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6058 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6064 C Contribution from graph IV
6066 call transpose2(EE(1,1,itj),auxmat(1,1))
6067 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6068 vv(1)=pizda(1,1)+pizda(2,2)
6069 vv(2)=pizda(2,1)-pizda(1,2)
6070 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6071 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6073 C Explicit gradient in virtual-dihedral angles.
6074 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6075 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6076 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6077 vv(1)=pizda(1,1)+pizda(2,2)
6078 vv(2)=pizda(2,1)-pizda(1,2)
6079 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6080 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6081 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6082 C Cartesian gradient
6086 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6088 vv(1)=pizda(1,1)+pizda(2,2)
6089 vv(2)=pizda(2,1)-pizda(1,2)
6090 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6091 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6092 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6099 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6100 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6101 cd write (2,*) 'ijkl',i,j,k,l
6102 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6103 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6105 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6106 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6107 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6108 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6110 if (j.lt.nres-1) then
6117 if (l.lt.nres-1) then
6127 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6129 ggg1(ll)=eel5*g_contij(ll,1)
6130 ggg2(ll)=eel5*g_contij(ll,2)
6131 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6132 ghalf=0.5d0*ggg1(ll)
6134 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6135 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6136 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6137 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6138 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6139 ghalf=0.5d0*ggg2(ll)
6141 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6142 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6143 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6144 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6149 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6150 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6155 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6156 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6162 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6167 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6171 cd write (2,*) iii,g_corr5_loc(iii)
6175 cd write (2,*) 'ekont',ekont
6176 cd write (iout,*) 'eello5',ekont*eel5
6179 c--------------------------------------------------------------------------
6180 double precision function eello6(i,j,k,l,jj,kk)
6181 implicit real*8 (a-h,o-z)
6182 include 'DIMENSIONS'
6183 include 'sizesclu.dat'
6184 include 'COMMON.IOUNITS'
6185 include 'COMMON.CHAIN'
6186 include 'COMMON.DERIV'
6187 include 'COMMON.INTERACT'
6188 include 'COMMON.CONTACTS'
6189 include 'COMMON.TORSION'
6190 include 'COMMON.VAR'
6191 include 'COMMON.GEO'
6192 include 'COMMON.FFIELD'
6193 double precision ggg1(3),ggg2(3)
6194 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6199 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6207 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6208 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6212 derx(lll,kkk,iii)=0.0d0
6216 cd eij=facont_hb(jj,i)
6217 cd ekl=facont_hb(kk,k)
6223 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6224 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6225 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6226 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6227 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6228 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6230 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6231 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6232 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6233 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6234 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6235 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6239 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6241 C If turn contributions are considered, they will be handled separately.
6242 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6243 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6244 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6245 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6246 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6247 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6248 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6251 if (j.lt.nres-1) then
6258 if (l.lt.nres-1) then
6266 ggg1(ll)=eel6*g_contij(ll,1)
6267 ggg2(ll)=eel6*g_contij(ll,2)
6268 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6269 ghalf=0.5d0*ggg1(ll)
6271 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6272 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6273 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6274 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6275 ghalf=0.5d0*ggg2(ll)
6276 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6278 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6279 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6280 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6281 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6286 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6287 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6292 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6293 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6299 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6304 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6308 cd write (2,*) iii,g_corr6_loc(iii)
6312 cd write (2,*) 'ekont',ekont
6313 cd write (iout,*) 'eello6',ekont*eel6
6316 c--------------------------------------------------------------------------
6317 double precision function eello6_graph1(i,j,k,l,imat,swap)
6318 implicit real*8 (a-h,o-z)
6319 include 'DIMENSIONS'
6320 include 'sizesclu.dat'
6321 include 'COMMON.IOUNITS'
6322 include 'COMMON.CHAIN'
6323 include 'COMMON.DERIV'
6324 include 'COMMON.INTERACT'
6325 include 'COMMON.CONTACTS'
6326 include 'COMMON.TORSION'
6327 include 'COMMON.VAR'
6328 include 'COMMON.GEO'
6329 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6333 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6335 C Parallel Antiparallel C
6341 C \ j|/k\| / \ |/k\|l / C
6346 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6347 itk=itortyp(itype(k))
6348 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6349 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6350 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6351 call transpose2(EUgC(1,1,k),auxmat(1,1))
6352 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6353 vv1(1)=pizda1(1,1)-pizda1(2,2)
6354 vv1(2)=pizda1(1,2)+pizda1(2,1)
6355 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6356 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6357 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6358 s5=scalar2(vv(1),Dtobr2(1,i))
6359 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6360 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6361 if (.not. calc_grad) return
6362 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6363 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6364 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6365 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6366 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6367 & +scalar2(vv(1),Dtobr2der(1,i)))
6368 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6369 vv1(1)=pizda1(1,1)-pizda1(2,2)
6370 vv1(2)=pizda1(1,2)+pizda1(2,1)
6371 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6372 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6374 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6375 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6376 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6377 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6378 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6380 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6381 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6382 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6383 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6384 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6386 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6387 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6388 vv1(1)=pizda1(1,1)-pizda1(2,2)
6389 vv1(2)=pizda1(1,2)+pizda1(2,1)
6390 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6391 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6392 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6393 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6402 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6403 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6404 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6405 call transpose2(EUgC(1,1,k),auxmat(1,1))
6406 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6408 vv1(1)=pizda1(1,1)-pizda1(2,2)
6409 vv1(2)=pizda1(1,2)+pizda1(2,1)
6410 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6411 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6412 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6413 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6414 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6415 s5=scalar2(vv(1),Dtobr2(1,i))
6416 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6422 c----------------------------------------------------------------------------
6423 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6424 implicit real*8 (a-h,o-z)
6425 include 'DIMENSIONS'
6426 include 'sizesclu.dat'
6427 include 'COMMON.IOUNITS'
6428 include 'COMMON.CHAIN'
6429 include 'COMMON.DERIV'
6430 include 'COMMON.INTERACT'
6431 include 'COMMON.CONTACTS'
6432 include 'COMMON.TORSION'
6433 include 'COMMON.VAR'
6434 include 'COMMON.GEO'
6436 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6437 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6440 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6442 C Parallel Antiparallel C
6448 C \ j|/k\| \ |/k\|l C
6453 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6454 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6455 C AL 7/4/01 s1 would occur in the sixth-order moment,
6456 C but not in a cluster cumulant
6458 s1=dip(1,jj,i)*dip(1,kk,k)
6460 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6461 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6462 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6463 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6464 call transpose2(EUg(1,1,k),auxmat(1,1))
6465 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6466 vv(1)=pizda(1,1)-pizda(2,2)
6467 vv(2)=pizda(1,2)+pizda(2,1)
6468 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6469 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6471 eello6_graph2=-(s1+s2+s3+s4)
6473 eello6_graph2=-(s2+s3+s4)
6476 if (.not. calc_grad) return
6477 C Derivatives in gamma(i-1)
6480 s1=dipderg(1,jj,i)*dip(1,kk,k)
6482 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6483 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6484 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6485 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6487 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6489 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6491 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6493 C Derivatives in gamma(k-1)
6495 s1=dip(1,jj,i)*dipderg(1,kk,k)
6497 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6498 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6499 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6500 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6501 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6502 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6503 vv(1)=pizda(1,1)-pizda(2,2)
6504 vv(2)=pizda(1,2)+pizda(2,1)
6505 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6507 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6509 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6511 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6512 C Derivatives in gamma(j-1) or gamma(l-1)
6515 s1=dipderg(3,jj,i)*dip(1,kk,k)
6517 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6518 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6519 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6520 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6521 vv(1)=pizda(1,1)-pizda(2,2)
6522 vv(2)=pizda(1,2)+pizda(2,1)
6523 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6526 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6528 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6531 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6532 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6534 C Derivatives in gamma(l-1) or gamma(j-1)
6537 s1=dip(1,jj,i)*dipderg(3,kk,k)
6539 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6540 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6541 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6542 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6543 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(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))
6549 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6551 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6554 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6555 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6557 C Cartesian derivatives.
6559 write (2,*) 'In eello6_graph2'
6561 write (2,*) 'iii=',iii
6563 write (2,*) 'kkk=',kkk
6565 write (2,'(3(2f10.5),5x)')
6566 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6576 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6578 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6581 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6583 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6584 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6586 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6587 call transpose2(EUg(1,1,k),auxmat(1,1))
6588 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6590 vv(1)=pizda(1,1)-pizda(2,2)
6591 vv(2)=pizda(1,2)+pizda(2,1)
6592 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6593 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6595 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6597 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6600 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6602 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6609 c----------------------------------------------------------------------------
6610 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6611 implicit real*8 (a-h,o-z)
6612 include 'DIMENSIONS'
6613 include 'sizesclu.dat'
6614 include 'COMMON.IOUNITS'
6615 include 'COMMON.CHAIN'
6616 include 'COMMON.DERIV'
6617 include 'COMMON.INTERACT'
6618 include 'COMMON.CONTACTS'
6619 include 'COMMON.TORSION'
6620 include 'COMMON.VAR'
6621 include 'COMMON.GEO'
6622 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6624 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6626 C Parallel Antiparallel C
6632 C j|/k\| / |/k\|l / C
6637 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6639 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6640 C energy moment and not to the cluster cumulant.
6641 iti=itortyp(itype(i))
6642 if (j.lt.nres-1) then
6643 itj1=itortyp(itype(j+1))
6647 itk=itortyp(itype(k))
6648 itk1=itortyp(itype(k+1))
6649 if (l.lt.nres-1) then
6650 itl1=itortyp(itype(l+1))
6655 s1=dip(4,jj,i)*dip(4,kk,k)
6657 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6658 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6659 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6660 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6661 call transpose2(EE(1,1,itk),auxmat(1,1))
6662 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6663 vv(1)=pizda(1,1)+pizda(2,2)
6664 vv(2)=pizda(2,1)-pizda(1,2)
6665 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6666 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6668 eello6_graph3=-(s1+s2+s3+s4)
6670 eello6_graph3=-(s2+s3+s4)
6673 if (.not. calc_grad) return
6674 C Derivatives in gamma(k-1)
6675 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6676 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6677 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6678 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6679 C Derivatives in gamma(l-1)
6680 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6681 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6682 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6683 vv(1)=pizda(1,1)+pizda(2,2)
6684 vv(2)=pizda(2,1)-pizda(1,2)
6685 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6686 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6687 C Cartesian derivatives.
6693 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6695 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6698 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6700 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6701 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6703 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6704 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6706 vv(1)=pizda(1,1)+pizda(2,2)
6707 vv(2)=pizda(2,1)-pizda(1,2)
6708 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6710 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6712 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6715 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6717 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6719 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6725 c----------------------------------------------------------------------------
6726 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6727 implicit real*8 (a-h,o-z)
6728 include 'DIMENSIONS'
6729 include 'sizesclu.dat'
6730 include 'COMMON.IOUNITS'
6731 include 'COMMON.CHAIN'
6732 include 'COMMON.DERIV'
6733 include 'COMMON.INTERACT'
6734 include 'COMMON.CONTACTS'
6735 include 'COMMON.TORSION'
6736 include 'COMMON.VAR'
6737 include 'COMMON.GEO'
6738 include 'COMMON.FFIELD'
6739 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6740 & auxvec1(2),auxmat1(2,2)
6742 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6744 C Parallel Antiparallel C
6750 C \ j|/k\| \ |/k\|l C
6755 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6757 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6758 C energy moment and not to the cluster cumulant.
6759 cd write (2,*) 'eello_graph4: wturn6',wturn6
6760 iti=itortyp(itype(i))
6761 itj=itortyp(itype(j))
6762 if (j.lt.nres-1) then
6763 itj1=itortyp(itype(j+1))
6767 itk=itortyp(itype(k))
6768 if (k.lt.nres-1) then
6769 itk1=itortyp(itype(k+1))
6773 itl=itortyp(itype(l))
6774 if (l.lt.nres-1) then
6775 itl1=itortyp(itype(l+1))
6779 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6780 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6781 cd & ' itl',itl,' itl1',itl1
6784 s1=dip(3,jj,i)*dip(3,kk,k)
6786 s1=dip(2,jj,j)*dip(2,kk,l)
6789 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6790 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6792 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6793 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6795 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6796 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6798 call transpose2(EUg(1,1,k),auxmat(1,1))
6799 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6800 vv(1)=pizda(1,1)-pizda(2,2)
6801 vv(2)=pizda(2,1)+pizda(1,2)
6802 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6803 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6805 eello6_graph4=-(s1+s2+s3+s4)
6807 eello6_graph4=-(s2+s3+s4)
6809 if (.not. calc_grad) return
6810 C Derivatives in gamma(i-1)
6814 s1=dipderg(2,jj,i)*dip(3,kk,k)
6816 s1=dipderg(4,jj,j)*dip(2,kk,l)
6819 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6821 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6822 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6824 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6825 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6827 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6828 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6829 cd write (2,*) 'turn6 derivatives'
6831 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6833 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6837 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6839 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6843 C Derivatives in gamma(k-1)
6846 s1=dip(3,jj,i)*dipderg(2,kk,k)
6848 s1=dip(2,jj,j)*dipderg(4,kk,l)
6851 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6852 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6854 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6855 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6857 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6858 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6860 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6861 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6862 vv(1)=pizda(1,1)-pizda(2,2)
6863 vv(2)=pizda(2,1)+pizda(1,2)
6864 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6865 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6867 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6869 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6873 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6875 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6878 C Derivatives in gamma(j-1) or gamma(l-1)
6879 if (l.eq.j+1 .and. l.gt.1) then
6880 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6881 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6882 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6883 vv(1)=pizda(1,1)-pizda(2,2)
6884 vv(2)=pizda(2,1)+pizda(1,2)
6885 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6886 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6887 else if (j.gt.1) then
6888 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6889 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6890 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6891 vv(1)=pizda(1,1)-pizda(2,2)
6892 vv(2)=pizda(2,1)+pizda(1,2)
6893 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6894 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6895 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6897 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6900 C Cartesian derivatives.
6907 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6909 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6913 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6915 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6919 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6921 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6923 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6924 & b1(1,itj1),auxvec(1))
6925 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6927 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6928 & b1(1,itl1),auxvec(1))
6929 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6931 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6933 vv(1)=pizda(1,1)-pizda(2,2)
6934 vv(2)=pizda(2,1)+pizda(1,2)
6935 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6937 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6939 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6942 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6945 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6948 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6950 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6952 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6956 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6958 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6961 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6963 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6971 c----------------------------------------------------------------------------
6972 double precision function eello_turn6(i,jj,kk)
6973 implicit real*8 (a-h,o-z)
6974 include 'DIMENSIONS'
6975 include 'sizesclu.dat'
6976 include 'COMMON.IOUNITS'
6977 include 'COMMON.CHAIN'
6978 include 'COMMON.DERIV'
6979 include 'COMMON.INTERACT'
6980 include 'COMMON.CONTACTS'
6981 include 'COMMON.TORSION'
6982 include 'COMMON.VAR'
6983 include 'COMMON.GEO'
6984 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6985 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6987 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6988 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6989 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6990 C the respective energy moment and not to the cluster cumulant.
6995 iti=itortyp(itype(i))
6996 itk=itortyp(itype(k))
6997 itk1=itortyp(itype(k+1))
6998 itl=itortyp(itype(l))
6999 itj=itortyp(itype(j))
7000 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7001 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7002 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7007 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7009 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7013 derx_turn(lll,kkk,iii)=0.0d0
7020 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7022 cd write (2,*) 'eello6_5',eello6_5
7024 call transpose2(AEA(1,1,1),auxmat(1,1))
7025 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7026 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7027 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7031 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7032 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7033 s2 = scalar2(b1(1,itk),vtemp1(1))
7035 call transpose2(AEA(1,1,2),atemp(1,1))
7036 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7037 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7038 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7042 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7043 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7044 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7046 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7047 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7048 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7049 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7050 ss13 = scalar2(b1(1,itk),vtemp4(1))
7051 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7055 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7061 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7063 C Derivatives in gamma(i+2)
7065 call transpose2(AEA(1,1,1),auxmatd(1,1))
7066 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7067 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7068 call transpose2(AEAderg(1,1,2),atempd(1,1))
7069 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7070 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7074 call matmat2(EUg(1,1,i+3),AEAderg(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))
7082 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7083 C Derivatives in gamma(i+3)
7085 call transpose2(AEA(1,1,1),auxmatd(1,1))
7086 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7087 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7088 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7092 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7093 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7094 s2d = scalar2(b1(1,itk),vtemp1d(1))
7096 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7097 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7099 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7101 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7102 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7103 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7113 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7114 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7116 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7117 & -0.5d0*ekont*(s2d+s12d)
7119 C Derivatives in gamma(i+4)
7120 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7121 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7122 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7124 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7125 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7126 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7136 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7138 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7140 C Derivatives in gamma(i+5)
7142 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7143 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7144 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7148 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7149 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7150 s2d = scalar2(b1(1,itk),vtemp1d(1))
7152 call transpose2(AEA(1,1,2),atempd(1,1))
7153 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7154 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7158 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7159 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7161 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7162 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7163 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7173 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7174 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7176 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7177 & -0.5d0*ekont*(s2d+s12d)
7179 C Cartesian derivatives
7184 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7185 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7186 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7190 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7191 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7193 s2d = scalar2(b1(1,itk),vtemp1d(1))
7195 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7196 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7197 s8d = -(atempd(1,1)+atempd(2,2))*
7198 & scalar2(cc(1,1,itl),vtemp2(1))
7202 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7204 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7205 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7212 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7215 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7219 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7220 & - 0.5d0*(s8d+s12d)
7222 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7231 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7233 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7234 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7235 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7236 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7237 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7239 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7240 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7241 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7245 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7246 cd & 16*eel_turn6_num
7248 if (j.lt.nres-1) then
7255 if (l.lt.nres-1) then
7263 ggg1(ll)=eel_turn6*g_contij(ll,1)
7264 ggg2(ll)=eel_turn6*g_contij(ll,2)
7265 ghalf=0.5d0*ggg1(ll)
7267 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7268 & +ekont*derx_turn(ll,2,1)
7269 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7270 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7271 & +ekont*derx_turn(ll,4,1)
7272 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7273 ghalf=0.5d0*ggg2(ll)
7275 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7276 & +ekont*derx_turn(ll,2,2)
7277 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7278 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7279 & +ekont*derx_turn(ll,4,2)
7280 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7285 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7290 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7296 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7301 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7305 cd write (2,*) iii,g_corr6_loc(iii)
7308 eello_turn6=ekont*eel_turn6
7309 cd write (2,*) 'ekont',ekont
7310 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7313 crc-------------------------------------------------
7314 SUBROUTINE MATVEC2(A1,V1,V2)
7315 implicit real*8 (a-h,o-z)
7316 include 'DIMENSIONS'
7317 DIMENSION A1(2,2),V1(2),V2(2)
7321 c 3 VI=VI+A1(I,K)*V1(K)
7325 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7326 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7331 C---------------------------------------
7332 SUBROUTINE MATMAT2(A1,A2,A3)
7333 implicit real*8 (a-h,o-z)
7334 include 'DIMENSIONS'
7335 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7336 c DIMENSION AI3(2,2)
7340 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7346 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7347 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7348 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7349 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7357 c-------------------------------------------------------------------------
7358 double precision function scalar2(u,v)
7360 double precision u(2),v(2)
7363 scalar2=u(1)*v(1)+u(2)*v(2)
7367 C-----------------------------------------------------------------------------
7369 subroutine transpose2(a,at)
7371 double precision a(2,2),at(2,2)
7378 c--------------------------------------------------------------------------
7379 subroutine transpose(n,a,at)
7382 double precision a(n,n),at(n,n)
7390 C---------------------------------------------------------------------------
7391 subroutine prodmat3(a1,a2,kk,transp,prod)
7394 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7396 crc double precision auxmat(2,2),prod_(2,2)
7399 crc call transpose2(kk(1,1),auxmat(1,1))
7400 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7401 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7403 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7404 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7405 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7406 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7407 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7408 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7409 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7410 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7413 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7414 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7416 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7417 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7418 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7419 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7420 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7421 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7422 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7423 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7426 c call transpose2(a2(1,1),a2t(1,1))
7429 crc print *,((prod_(i,j),i=1,2),j=1,2)
7430 crc print *,((prod(i,j),i=1,2),j=1,2)
7434 C-----------------------------------------------------------------------------
7435 double precision function scalar(u,v)
7437 double precision u(3),v(3)