1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
8 cMS$ATTRIBUTES C :: proc_proc
11 include 'COMMON.IOUNITS'
12 double precision energia(0:max_ene),energia1(0:max_ene+1)
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
23 double precision fact(5)
24 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
25 cd print *,'nnt=',nnt,' nct=',nct
27 C Compute the side-chain and electrostatic interaction energy
29 goto (101,102,103,104,105) ipot
30 C Lennard-Jones potential.
32 cd print '(a)','Exit ELJ'
34 C Lennard-Jones-Kihara potential (shifted).
37 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 C Gay-Berne potential (shifted LJ, angular dependence).
43 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 C Calculate electrostatic (H-bonding) energy of the main chain.
48 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
50 C Calculate excluded-volume interaction energy between peptide groups
53 call escp(evdw2,evdw2_14)
55 c Calculate the bond-stretching energy
58 c write (iout,*) "estr",estr
60 C Calculate the disulfide-bridge and other energy and the contributions
61 C from other distance constraints.
62 cd print *,'Calling EHPB'
64 cd print *,'EHPB exitted succesfully.'
66 C Calculate the virtual-bond-angle energy.
69 cd print *,'Bend energy finished.'
71 C Calculate the SC local energy.
74 cd print *,'SCLOC energy finished.'
76 C Calculate the virtual-bond torsional energy.
78 cd print *,'nterm=',nterm
79 call etor(etors,edihcnstr,fact(1))
81 C 6/23/01 Calculate double-torsional energy
83 call etor_d(etors_d,fact(2))
85 C 21/5/07 Calculate local sicdechain correlation energy
87 call eback_sc_corr(esccor,fact(1))
89 C 12/1/95 Multi-body terms
93 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
94 & .or. wturn6.gt.0.0d0) then
95 c print *,"calling multibody_eello"
96 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
97 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
98 c print *,ecorr,ecorr5,ecorr6,eturn6
100 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
101 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
103 C call multibody(ecorr)
108 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*ees+wvdwpp*evdw1
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*(ees+evdw1)
117 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
118 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
119 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
120 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
121 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
122 & +wbond*estr+wsccor*fact(1)*esccor
127 energia(2)=evdw2-evdw2_14
144 energia(8)=eello_turn3
145 energia(9)=eello_turn4
154 energia(20)=edihcnstr
158 idumm=proc_proc(etot,i)
160 call proc_proc(etot,i)
162 if(i.eq.1)energia(0)=1.0d+99
168 C Sum up the components of the Cartesian gradient.
173 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
174 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
176 & wstrain*ghpbc(j,i)+
177 & wcorr*fact(3)*gradcorr(j,i)+
178 & wel_loc*fact(2)*gel_loc(j,i)+
179 & wturn3*fact(2)*gcorr3_turn(j,i)+
180 & wturn4*fact(3)*gcorr4_turn(j,i)+
181 & wcorr5*fact(4)*gradcorr5(j,i)+
182 & wcorr6*fact(5)*gradcorr6(j,i)+
183 & wturn6*fact(5)*gcorr6_turn(j,i)+
184 & wsccor*fact(2)*gsccorc(j,i)
185 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
187 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
192 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
193 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
195 & wcorr*fact(3)*gradcorr(j,i)+
196 & wel_loc*fact(2)*gel_loc(j,i)+
197 & wturn3*fact(2)*gcorr3_turn(j,i)+
198 & wturn4*fact(3)*gcorr4_turn(j,i)+
199 & wcorr5*fact(4)*gradcorr5(j,i)+
200 & wcorr6*fact(5)*gradcorr6(j,i)+
201 & wturn6*fact(5)*gcorr6_turn(j,i)+
202 & wsccor*fact(2)*gsccorc(j,i)
203 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
205 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
208 cd print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3),
209 cd & (gradc(k,i),k=1,3)
214 cd write (iout,*) i,g_corr5_loc(i)
215 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
216 & +wcorr5*fact(4)*g_corr5_loc(i)
217 & +wcorr6*fact(5)*g_corr6_loc(i)
218 & +wturn4*fact(3)*gel_loc_turn4(i)
219 & +wturn3*fact(2)*gel_loc_turn3(i)
220 & +wturn6*fact(5)*gel_loc_turn6(i)
221 & +wel_loc*fact(2)*gel_loc_loc(i)+
222 & +wsccor*fact(1)*gsccor_loc(i)
225 cd call enerprint(energia(0),fact)
230 C------------------------------------------------------------------------
231 subroutine enerprint(energia,fact)
232 implicit real*8 (a-h,o-z)
234 include 'sizesclu.dat'
235 include 'COMMON.IOUNITS'
236 include 'COMMON.FFIELD'
237 include 'COMMON.SBRIDGE'
238 double precision energia(0:max_ene),fact(5)
242 evdw2=energia(2)+energia(17)
254 eello_turn3=energia(8)
255 eello_turn4=energia(9)
256 eello_turn6=energia(10)
263 edihcnstr=energia(20)
266 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
268 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
269 & etors_d,wtor_d*fact(2),ehpb,wstrain,
270 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
271 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
272 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
273 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
274 10 format (/'Virtual-chain energies:'//
275 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
276 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
277 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
278 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
279 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
280 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
281 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
282 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
283 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
284 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
285 & ' (SS bridges & dist. cnstr.)'/
286 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
287 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
288 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
289 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
290 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
291 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
292 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
293 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
294 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
295 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
296 & 'ETOT= ',1pE16.6,' (total)')
298 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
299 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
300 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
301 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
302 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
303 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
304 & edihcnstr,ebr*nss,etot
305 10 format (/'Virtual-chain energies:'//
306 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
307 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
308 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
309 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
310 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
311 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
312 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
313 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
314 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
315 & ' (SS bridges & dist. cnstr.)'/
316 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
317 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
318 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
319 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
320 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
321 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
322 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
323 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
324 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
325 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
326 & 'ETOT= ',1pE16.6,' (total)')
330 C-----------------------------------------------------------------------
333 C This subroutine calculates the interaction energy of nonbonded side chains
334 C assuming the LJ potential of interaction.
336 implicit real*8 (a-h,o-z)
338 include 'sizesclu.dat'
339 c include "DIMENSIONS.COMPAR"
340 parameter (accur=1.0d-10)
343 include 'COMMON.LOCAL'
344 include 'COMMON.CHAIN'
345 include 'COMMON.DERIV'
346 include 'COMMON.INTERACT'
347 include 'COMMON.TORSION'
348 include 'COMMON.SBRIDGE'
349 include 'COMMON.NAMES'
350 include 'COMMON.IOUNITS'
351 include 'COMMON.CONTACTS'
355 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
359 itypi1=iabs(itype(i+1))
366 C Calculate SC interaction energy.
369 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
370 cd & 'iend=',iend(i,iint)
371 do j=istart(i,iint),iend(i,iint)
376 C Change 12/1/95 to calculate four-body interactions
377 rij=xj*xj+yj*yj+zj*zj
379 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
380 eps0ij=eps(itypi,itypj)
382 e1=fac*fac*aa(itypi,itypj)
383 e2=fac*bb(itypi,itypj)
385 ij=icant(itypi,itypj)
386 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
387 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
388 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
389 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
390 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
391 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
395 C Calculate the components of the gradient in DC and X
397 fac=-rrij*(e1+evdwij)
402 gvdwx(k,i)=gvdwx(k,i)-gg(k)
403 gvdwx(k,j)=gvdwx(k,j)+gg(k)
407 gvdwc(l,k)=gvdwc(l,k)+gg(l)
412 C 12/1/95, revised on 5/20/97
414 C Calculate the contact function. The ith column of the array JCONT will
415 C contain the numbers of atoms that make contacts with the atom I (of numbers
416 C greater than I). The arrays FACONT and GACONT will contain the values of
417 C the contact function and its derivative.
419 C Uncomment next line, if the correlation interactions include EVDW explicitly.
420 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
421 C Uncomment next line, if the correlation interactions are contact function only
422 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
424 sigij=sigma(itypi,itypj)
425 r0ij=rs0(itypi,itypj)
427 C Check whether the SC's are not too far to make a contact.
430 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
431 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
433 if (fcont.gt.0.0D0) then
434 C If the SC-SC distance if close to sigma, apply spline.
435 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
436 cAdam & fcont1,fprimcont1)
437 cAdam fcont1=1.0d0-fcont1
438 cAdam if (fcont1.gt.0.0d0) then
439 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
440 cAdam fcont=fcont*fcont1
442 C Uncomment following 4 lines to have the geometric average of the epsilon0's
443 cga eps0ij=1.0d0/dsqrt(eps0ij)
445 cga gg(k)=gg(k)*eps0ij
447 cga eps0ij=-evdwij*eps0ij
448 C Uncomment for AL's type of SC correlation interactions.
450 num_conti=num_conti+1
452 facont(num_conti,i)=fcont*eps0ij
453 fprimcont=eps0ij*fprimcont/rij
455 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
456 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
457 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
458 C Uncomment following 3 lines for Skolnick's type of SC correlation.
459 gacont(1,num_conti,i)=-fprimcont*xj
460 gacont(2,num_conti,i)=-fprimcont*yj
461 gacont(3,num_conti,i)=-fprimcont*zj
462 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
463 cd write (iout,'(2i3,3f10.5)')
464 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
470 num_cont(i)=num_conti
475 gvdwc(j,i)=expon*gvdwc(j,i)
476 gvdwx(j,i)=expon*gvdwx(j,i)
480 C******************************************************************************
484 C To save time, the factor of EXPON has been extracted from ALL components
485 C of GVDWC and GRADX. Remember to multiply them by this factor before further
488 C******************************************************************************
491 C-----------------------------------------------------------------------------
492 subroutine eljk(evdw)
494 C This subroutine calculates the interaction energy of nonbonded side chains
495 C assuming the LJK potential of interaction.
497 implicit real*8 (a-h,o-z)
499 include 'sizesclu.dat'
500 c include "DIMENSIONS.COMPAR"
503 include 'COMMON.LOCAL'
504 include 'COMMON.CHAIN'
505 include 'COMMON.DERIV'
506 include 'COMMON.INTERACT'
507 include 'COMMON.IOUNITS'
508 include 'COMMON.NAMES'
513 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
517 itypi1=iabs(itype(i+1))
522 C Calculate SC interaction energy.
525 do j=istart(i,iint),iend(i,iint)
530 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
532 e_augm=augm(itypi,itypj)*fac_augm
535 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
536 fac=r_shift_inv**expon
537 e1=fac*fac*aa(itypi,itypj)
538 e2=fac*bb(itypi,itypj)
540 ij=icant(itypi,itypj)
541 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
542 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
543 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
544 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
545 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
546 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
547 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
551 C Calculate the components of the gradient in DC and X
553 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
558 gvdwx(k,i)=gvdwx(k,i)-gg(k)
559 gvdwx(k,j)=gvdwx(k,j)+gg(k)
563 gvdwc(l,k)=gvdwc(l,k)+gg(l)
573 gvdwc(j,i)=expon*gvdwc(j,i)
574 gvdwx(j,i)=expon*gvdwx(j,i)
580 C-----------------------------------------------------------------------------
583 C This subroutine calculates the interaction energy of nonbonded side chains
584 C assuming the Berne-Pechukas potential of interaction.
586 implicit real*8 (a-h,o-z)
588 include 'sizesclu.dat'
589 c include "DIMENSIONS.COMPAR"
592 include 'COMMON.LOCAL'
593 include 'COMMON.CHAIN'
594 include 'COMMON.DERIV'
595 include 'COMMON.NAMES'
596 include 'COMMON.INTERACT'
597 include 'COMMON.IOUNITS'
598 include 'COMMON.CALC'
600 c double precision rrsave(maxdim)
605 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
607 c if (icall.eq.0) then
615 itypi1=iabs(itype(i+1))
619 dxi=dc_norm(1,nres+i)
620 dyi=dc_norm(2,nres+i)
621 dzi=dc_norm(3,nres+i)
622 dsci_inv=vbld_inv(i+nres)
624 C Calculate SC interaction energy.
627 do j=istart(i,iint),iend(i,iint)
630 dscj_inv=vbld_inv(j+nres)
631 chi1=chi(itypi,itypj)
632 chi2=chi(itypj,itypi)
639 alf12=0.5D0*(alf1+alf2)
640 C For diagnostics only!!!
653 dxj=dc_norm(1,nres+j)
654 dyj=dc_norm(2,nres+j)
655 dzj=dc_norm(3,nres+j)
656 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
657 cd if (icall.eq.0) then
663 C Calculate the angle-dependent terms of energy & contributions to derivatives.
665 C Calculate whole angle-dependent part of epsilon and contributions
667 fac=(rrij*sigsq)**expon2
668 e1=fac*fac*aa(itypi,itypj)
669 e2=fac*bb(itypi,itypj)
670 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
671 eps2der=evdwij*eps3rt
672 eps3der=evdwij*eps2rt
673 evdwij=evdwij*eps2rt*eps3rt
674 ij=icant(itypi,itypj)
675 aux=eps1*eps2rt**2*eps3rt**2
679 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
680 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
681 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
682 cd & restyp(itypi),i,restyp(itypj),j,
683 cd & epsi,sigm,chi1,chi2,chip1,chip2,
684 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
685 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
688 C Calculate gradient components.
689 e1=e1*eps1*eps2rt**2*eps3rt**2
690 fac=-expon*(e1+evdwij)
693 C Calculate radial part of the gradient
697 C Calculate the angular part of the gradient and sum add the contributions
698 C to the appropriate components of the Cartesian gradient.
707 C-----------------------------------------------------------------------------
710 C This subroutine calculates the interaction energy of nonbonded side chains
711 C assuming the Gay-Berne potential of interaction.
713 implicit real*8 (a-h,o-z)
715 include 'sizesclu.dat'
716 c include "DIMENSIONS.COMPAR"
719 include 'COMMON.LOCAL'
720 include 'COMMON.CHAIN'
721 include 'COMMON.DERIV'
722 include 'COMMON.NAMES'
723 include 'COMMON.INTERACT'
724 include 'COMMON.IOUNITS'
725 include 'COMMON.CALC'
731 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
734 c if (icall.gt.0) lprn=.true.
738 itypi1=iabs(itype(i+1))
742 dxi=dc_norm(1,nres+i)
743 dyi=dc_norm(2,nres+i)
744 dzi=dc_norm(3,nres+i)
745 dsci_inv=vbld_inv(i+nres)
747 C Calculate SC interaction energy.
750 do j=istart(i,iint),iend(i,iint)
753 dscj_inv=vbld_inv(j+nres)
754 sig0ij=sigma(itypi,itypj)
755 chi1=chi(itypi,itypj)
756 chi2=chi(itypj,itypi)
763 alf12=0.5D0*(alf1+alf2)
764 C For diagnostics only!!!
777 dxj=dc_norm(1,nres+j)
778 dyj=dc_norm(2,nres+j)
779 dzj=dc_norm(3,nres+j)
780 c write (iout,*) i,j,xj,yj,zj
781 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
783 C Calculate angle-dependent terms of energy and contributions to their
787 sig=sig0ij*dsqrt(sigsq)
788 rij_shift=1.0D0/rij-sig+sig0ij
789 C I hate to put IF's in the loops, but here don't have another choice!!!!
790 if (rij_shift.le.0.0D0) then
795 c---------------------------------------------------------------
796 rij_shift=1.0D0/rij_shift
798 e1=fac*fac*aa(itypi,itypj)
799 e2=fac*bb(itypi,itypj)
800 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
801 eps2der=evdwij*eps3rt
802 eps3der=evdwij*eps2rt
803 evdwij=evdwij*eps2rt*eps3rt
805 ij=icant(itypi,itypj)
806 aux=eps1*eps2rt**2*eps3rt**2
807 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
808 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
809 c & aux*e2/eps(itypi,itypj)
811 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
812 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
813 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
814 & restyp(itypi),i,restyp(itypj),j,
815 & epsi,sigm,chi1,chi2,chip1,chip2,
816 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
817 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
821 C Calculate gradient components.
822 e1=e1*eps1*eps2rt**2*eps3rt**2
823 fac=-expon*(e1+evdwij)*rij_shift
826 C Calculate the radial part of the gradient
830 C Calculate angular part of the gradient.
838 C-----------------------------------------------------------------------------
839 subroutine egbv(evdw)
841 C This subroutine calculates the interaction energy of nonbonded side chains
842 C assuming the Gay-Berne-Vorobjev potential of interaction.
844 implicit real*8 (a-h,o-z)
846 include 'sizesclu.dat'
847 c include "DIMENSIONS.COMPAR"
850 include 'COMMON.LOCAL'
851 include 'COMMON.CHAIN'
852 include 'COMMON.DERIV'
853 include 'COMMON.NAMES'
854 include 'COMMON.INTERACT'
855 include 'COMMON.IOUNITS'
856 include 'COMMON.CALC'
862 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
865 c if (icall.gt.0) lprn=.true.
869 itypi1=iabs(itype(i+1))
873 dxi=dc_norm(1,nres+i)
874 dyi=dc_norm(2,nres+i)
875 dzi=dc_norm(3,nres+i)
876 dsci_inv=vbld_inv(i+nres)
878 C Calculate SC interaction energy.
881 do j=istart(i,iint),iend(i,iint)
884 dscj_inv=vbld_inv(j+nres)
885 sig0ij=sigma(itypi,itypj)
887 chi1=chi(itypi,itypj)
888 chi2=chi(itypj,itypi)
895 alf12=0.5D0*(alf1+alf2)
896 C For diagnostics only!!!
909 dxj=dc_norm(1,nres+j)
910 dyj=dc_norm(2,nres+j)
911 dzj=dc_norm(3,nres+j)
912 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
914 C Calculate angle-dependent terms of energy and contributions to their
918 sig=sig0ij*dsqrt(sigsq)
919 rij_shift=1.0D0/rij-sig+r0ij
920 C I hate to put IF's in the loops, but here don't have another choice!!!!
921 if (rij_shift.le.0.0D0) then
926 c---------------------------------------------------------------
927 rij_shift=1.0D0/rij_shift
929 e1=fac*fac*aa(itypi,itypj)
930 e2=fac*bb(itypi,itypj)
931 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
932 eps2der=evdwij*eps3rt
933 eps3der=evdwij*eps2rt
935 e_augm=augm(itypi,itypj)*fac_augm
936 evdwij=evdwij*eps2rt*eps3rt
937 evdw=evdw+evdwij+e_augm
938 ij=icant(itypi,itypj)
939 aux=eps1*eps2rt**2*eps3rt**2
941 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
942 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
943 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
944 c & restyp(itypi),i,restyp(itypj),j,
945 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
946 c & chi1,chi2,chip1,chip2,
947 c & eps1,eps2rt**2,eps3rt**2,
948 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
952 C Calculate gradient components.
953 e1=e1*eps1*eps2rt**2*eps3rt**2
954 fac=-expon*(e1+evdwij)*rij_shift
956 fac=rij*fac-2*expon*rrij*e_augm
957 C Calculate the radial part of the gradient
961 C Calculate angular part of the gradient.
969 C-----------------------------------------------------------------------------
970 subroutine sc_angular
971 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
972 C om12. Called by ebp, egb, and egbv.
974 include 'COMMON.CALC'
978 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
979 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
980 om12=dxi*dxj+dyi*dyj+dzi*dzj
982 C Calculate eps1(om12) and its derivative in om12
983 faceps1=1.0D0-om12*chiom12
984 faceps1_inv=1.0D0/faceps1
985 eps1=dsqrt(faceps1_inv)
986 C Following variable is eps1*deps1/dom12
987 eps1_om12=faceps1_inv*chiom12
988 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
993 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
994 sigsq=1.0D0-facsig*faceps1_inv
995 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
996 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
997 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
998 C Calculate eps2 and its derivatives in om1, om2, and om12.
1001 chipom12=chip12*om12
1002 facp=1.0D0-om12*chipom12
1004 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1005 C Following variable is the square root of eps2
1006 eps2rt=1.0D0-facp1*facp_inv
1007 C Following three variables are the derivatives of the square root of eps
1008 C in om1, om2, and om12.
1009 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1010 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1011 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1012 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1013 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1014 C Calculate whole angle-dependent part of epsilon and contributions
1015 C to its derivatives
1018 C----------------------------------------------------------------------------
1020 implicit real*8 (a-h,o-z)
1021 include 'DIMENSIONS'
1022 include 'sizesclu.dat'
1023 include 'COMMON.CHAIN'
1024 include 'COMMON.DERIV'
1025 include 'COMMON.CALC'
1026 double precision dcosom1(3),dcosom2(3)
1027 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1028 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1029 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1030 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1032 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1033 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1036 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1039 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1040 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1041 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1042 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1043 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1044 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1047 C Calculate the components of the gradient in DC and X
1051 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1056 c------------------------------------------------------------------------------
1057 subroutine vec_and_deriv
1058 implicit real*8 (a-h,o-z)
1059 include 'DIMENSIONS'
1060 include 'sizesclu.dat'
1061 include 'COMMON.IOUNITS'
1062 include 'COMMON.GEO'
1063 include 'COMMON.VAR'
1064 include 'COMMON.LOCAL'
1065 include 'COMMON.CHAIN'
1066 include 'COMMON.VECTORS'
1067 include 'COMMON.DERIV'
1068 include 'COMMON.INTERACT'
1069 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1070 C Compute the local reference systems. For reference system (i), the
1071 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1072 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1074 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1075 if (i.eq.nres-1) then
1076 C Case of the last full residue
1077 C Compute the Z-axis
1078 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1079 costh=dcos(pi-theta(nres))
1080 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1085 C Compute the derivatives of uz
1087 uzder(2,1,1)=-dc_norm(3,i-1)
1088 uzder(3,1,1)= dc_norm(2,i-1)
1089 uzder(1,2,1)= dc_norm(3,i-1)
1091 uzder(3,2,1)=-dc_norm(1,i-1)
1092 uzder(1,3,1)=-dc_norm(2,i-1)
1093 uzder(2,3,1)= dc_norm(1,i-1)
1096 uzder(2,1,2)= dc_norm(3,i)
1097 uzder(3,1,2)=-dc_norm(2,i)
1098 uzder(1,2,2)=-dc_norm(3,i)
1100 uzder(3,2,2)= dc_norm(1,i)
1101 uzder(1,3,2)= dc_norm(2,i)
1102 uzder(2,3,2)=-dc_norm(1,i)
1105 C Compute the Y-axis
1108 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1111 C Compute the derivatives of uy
1114 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1115 & -dc_norm(k,i)*dc_norm(j,i-1)
1116 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1118 uyder(j,j,1)=uyder(j,j,1)-costh
1119 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1124 uygrad(l,k,j,i)=uyder(l,k,j)
1125 uzgrad(l,k,j,i)=uzder(l,k,j)
1129 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1130 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1131 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1132 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1136 C Compute the Z-axis
1137 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1138 costh=dcos(pi-theta(i+2))
1139 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1144 C Compute the derivatives of uz
1146 uzder(2,1,1)=-dc_norm(3,i+1)
1147 uzder(3,1,1)= dc_norm(2,i+1)
1148 uzder(1,2,1)= dc_norm(3,i+1)
1150 uzder(3,2,1)=-dc_norm(1,i+1)
1151 uzder(1,3,1)=-dc_norm(2,i+1)
1152 uzder(2,3,1)= dc_norm(1,i+1)
1155 uzder(2,1,2)= dc_norm(3,i)
1156 uzder(3,1,2)=-dc_norm(2,i)
1157 uzder(1,2,2)=-dc_norm(3,i)
1159 uzder(3,2,2)= dc_norm(1,i)
1160 uzder(1,3,2)= dc_norm(2,i)
1161 uzder(2,3,2)=-dc_norm(1,i)
1164 C Compute the Y-axis
1167 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1170 C Compute the derivatives of uy
1173 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1174 & -dc_norm(k,i)*dc_norm(j,i+1)
1175 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1177 uyder(j,j,1)=uyder(j,j,1)-costh
1178 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1183 uygrad(l,k,j,i)=uyder(l,k,j)
1184 uzgrad(l,k,j,i)=uzder(l,k,j)
1188 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1189 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1190 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1191 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1197 vbld_inv_temp(1)=vbld_inv(i+1)
1198 if (i.lt.nres-1) then
1199 vbld_inv_temp(2)=vbld_inv(i+2)
1201 vbld_inv_temp(2)=vbld_inv(i)
1206 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1207 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1215 C-----------------------------------------------------------------------------
1216 subroutine vec_and_deriv_test
1217 implicit real*8 (a-h,o-z)
1218 include 'DIMENSIONS'
1219 include 'sizesclu.dat'
1220 include 'COMMON.IOUNITS'
1221 include 'COMMON.GEO'
1222 include 'COMMON.VAR'
1223 include 'COMMON.LOCAL'
1224 include 'COMMON.CHAIN'
1225 include 'COMMON.VECTORS'
1226 dimension uyder(3,3,2),uzder(3,3,2)
1227 C Compute the local reference systems. For reference system (i), the
1228 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1229 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1231 if (i.eq.nres-1) then
1232 C Case of the last full residue
1233 C Compute the Z-axis
1234 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1235 costh=dcos(pi-theta(nres))
1236 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1237 c write (iout,*) 'fac',fac,
1238 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1239 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1243 C Compute the derivatives of uz
1245 uzder(2,1,1)=-dc_norm(3,i-1)
1246 uzder(3,1,1)= dc_norm(2,i-1)
1247 uzder(1,2,1)= dc_norm(3,i-1)
1249 uzder(3,2,1)=-dc_norm(1,i-1)
1250 uzder(1,3,1)=-dc_norm(2,i-1)
1251 uzder(2,3,1)= dc_norm(1,i-1)
1254 uzder(2,1,2)= dc_norm(3,i)
1255 uzder(3,1,2)=-dc_norm(2,i)
1256 uzder(1,2,2)=-dc_norm(3,i)
1258 uzder(3,2,2)= dc_norm(1,i)
1259 uzder(1,3,2)= dc_norm(2,i)
1260 uzder(2,3,2)=-dc_norm(1,i)
1262 C Compute the Y-axis
1264 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1267 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1268 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1269 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1271 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1274 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1275 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1278 c write (iout,*) 'facy',facy,
1279 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1280 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1282 uy(k,i)=facy*uy(k,i)
1284 C Compute the derivatives of uy
1287 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1288 & -dc_norm(k,i)*dc_norm(j,i-1)
1289 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1291 c uyder(j,j,1)=uyder(j,j,1)-costh
1292 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1293 uyder(j,j,1)=uyder(j,j,1)
1294 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1295 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1301 uygrad(l,k,j,i)=uyder(l,k,j)
1302 uzgrad(l,k,j,i)=uzder(l,k,j)
1306 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1307 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1308 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1309 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1312 C Compute the Z-axis
1313 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1314 costh=dcos(pi-theta(i+2))
1315 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1316 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1320 C Compute the derivatives of uz
1322 uzder(2,1,1)=-dc_norm(3,i+1)
1323 uzder(3,1,1)= dc_norm(2,i+1)
1324 uzder(1,2,1)= dc_norm(3,i+1)
1326 uzder(3,2,1)=-dc_norm(1,i+1)
1327 uzder(1,3,1)=-dc_norm(2,i+1)
1328 uzder(2,3,1)= dc_norm(1,i+1)
1331 uzder(2,1,2)= dc_norm(3,i)
1332 uzder(3,1,2)=-dc_norm(2,i)
1333 uzder(1,2,2)=-dc_norm(3,i)
1335 uzder(3,2,2)= dc_norm(1,i)
1336 uzder(1,3,2)= dc_norm(2,i)
1337 uzder(2,3,2)=-dc_norm(1,i)
1339 C Compute the Y-axis
1341 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1342 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1343 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1345 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1348 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1349 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1352 c write (iout,*) 'facy',facy,
1353 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1354 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1356 uy(k,i)=facy*uy(k,i)
1358 C Compute the derivatives of uy
1361 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1362 & -dc_norm(k,i)*dc_norm(j,i+1)
1363 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1365 c uyder(j,j,1)=uyder(j,j,1)-costh
1366 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1367 uyder(j,j,1)=uyder(j,j,1)
1368 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1369 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1375 uygrad(l,k,j,i)=uyder(l,k,j)
1376 uzgrad(l,k,j,i)=uzder(l,k,j)
1380 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1381 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1382 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1383 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1390 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1391 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1398 C-----------------------------------------------------------------------------
1399 subroutine check_vecgrad
1400 implicit real*8 (a-h,o-z)
1401 include 'DIMENSIONS'
1402 include 'sizesclu.dat'
1403 include 'COMMON.IOUNITS'
1404 include 'COMMON.GEO'
1405 include 'COMMON.VAR'
1406 include 'COMMON.LOCAL'
1407 include 'COMMON.CHAIN'
1408 include 'COMMON.VECTORS'
1409 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1410 dimension uyt(3,maxres),uzt(3,maxres)
1411 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1412 double precision delta /1.0d-7/
1415 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1416 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1417 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1418 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1419 cd & (dc_norm(if90,i),if90=1,3)
1420 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1421 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1422 cd write(iout,'(a)')
1428 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1429 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1442 cd write (iout,*) 'i=',i
1444 erij(k)=dc_norm(k,i)
1448 dc_norm(k,i)=erij(k)
1450 dc_norm(j,i)=dc_norm(j,i)+delta
1451 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1453 c dc_norm(k,i)=dc_norm(k,i)/fac
1455 c write (iout,*) (dc_norm(k,i),k=1,3)
1456 c write (iout,*) (erij(k),k=1,3)
1459 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1460 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1461 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1462 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1464 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1465 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1466 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1469 dc_norm(k,i)=erij(k)
1472 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1473 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1474 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1475 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1476 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1477 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1478 cd write (iout,'(a)')
1483 C--------------------------------------------------------------------------
1484 subroutine set_matrices
1485 implicit real*8 (a-h,o-z)
1486 include 'DIMENSIONS'
1487 include 'sizesclu.dat'
1488 include 'COMMON.IOUNITS'
1489 include 'COMMON.GEO'
1490 include 'COMMON.VAR'
1491 include 'COMMON.LOCAL'
1492 include 'COMMON.CHAIN'
1493 include 'COMMON.DERIV'
1494 include 'COMMON.INTERACT'
1495 include 'COMMON.CONTACTS'
1496 include 'COMMON.TORSION'
1497 include 'COMMON.VECTORS'
1498 include 'COMMON.FFIELD'
1499 double precision auxvec(2),auxmat(2,2)
1501 C Compute the virtual-bond-torsional-angle dependent quantities needed
1502 C to calculate the el-loc multibody terms of various order.
1505 if (i .lt. nres+1) then
1542 if (i .gt. 3 .and. i .lt. nres+1) then
1543 obrot_der(1,i-2)=-sin1
1544 obrot_der(2,i-2)= cos1
1545 Ugder(1,1,i-2)= sin1
1546 Ugder(1,2,i-2)=-cos1
1547 Ugder(2,1,i-2)=-cos1
1548 Ugder(2,2,i-2)=-sin1
1551 obrot2_der(1,i-2)=-dwasin2
1552 obrot2_der(2,i-2)= dwacos2
1553 Ug2der(1,1,i-2)= dwasin2
1554 Ug2der(1,2,i-2)=-dwacos2
1555 Ug2der(2,1,i-2)=-dwacos2
1556 Ug2der(2,2,i-2)=-dwasin2
1558 obrot_der(1,i-2)=0.0d0
1559 obrot_der(2,i-2)=0.0d0
1560 Ugder(1,1,i-2)=0.0d0
1561 Ugder(1,2,i-2)=0.0d0
1562 Ugder(2,1,i-2)=0.0d0
1563 Ugder(2,2,i-2)=0.0d0
1564 obrot2_der(1,i-2)=0.0d0
1565 obrot2_der(2,i-2)=0.0d0
1566 Ug2der(1,1,i-2)=0.0d0
1567 Ug2der(1,2,i-2)=0.0d0
1568 Ug2der(2,1,i-2)=0.0d0
1569 Ug2der(2,2,i-2)=0.0d0
1571 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1572 iti = itortyp(itype(i-2))
1576 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1577 iti1 = itortyp(itype(i-1))
1581 cd write (iout,*) '*******i',i,' iti1',iti
1582 cd write (iout,*) 'b1',b1(:,iti)
1583 cd write (iout,*) 'b2',b2(:,iti)
1584 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1585 if (i .gt. iatel_s+2) then
1586 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1587 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1588 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1589 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1590 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1591 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1592 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1602 DtUg2(l,k,i-2)=0.0d0
1606 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1607 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1608 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1609 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1610 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1611 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1612 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1614 muder(k,i-2)=Ub2der(k,i-2)
1616 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1617 iti1 = itortyp(itype(i-1))
1622 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1624 C Vectors and matrices dependent on a single virtual-bond dihedral.
1625 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1626 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1627 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1628 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1629 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1630 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1631 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1632 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1633 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1634 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1635 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1637 C Matrices dependent on two consecutive virtual-bond dihedrals.
1638 C The order of matrices is from left to right.
1640 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1641 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1642 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1643 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1644 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1645 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1646 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1647 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1650 cd iti = itortyp(itype(i))
1653 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1654 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1659 C--------------------------------------------------------------------------
1660 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1662 C This subroutine calculates the average interaction energy and its gradient
1663 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1664 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1665 C The potential depends both on the distance of peptide-group centers and on
1666 C the orientation of the CA-CA virtual bonds.
1668 implicit real*8 (a-h,o-z)
1669 include 'DIMENSIONS'
1670 include 'sizesclu.dat'
1671 include 'COMMON.CONTROL'
1672 include 'COMMON.IOUNITS'
1673 include 'COMMON.GEO'
1674 include 'COMMON.VAR'
1675 include 'COMMON.LOCAL'
1676 include 'COMMON.CHAIN'
1677 include 'COMMON.DERIV'
1678 include 'COMMON.INTERACT'
1679 include 'COMMON.CONTACTS'
1680 include 'COMMON.TORSION'
1681 include 'COMMON.VECTORS'
1682 include 'COMMON.FFIELD'
1683 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1684 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1685 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1686 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1687 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1688 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1689 double precision scal_el /0.5d0/
1691 C 13-go grudnia roku pamietnego...
1692 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1693 & 0.0d0,1.0d0,0.0d0,
1694 & 0.0d0,0.0d0,1.0d0/
1695 cd write(iout,*) 'In EELEC'
1697 cd write(iout,*) 'Type',i
1698 cd write(iout,*) 'B1',B1(:,i)
1699 cd write(iout,*) 'B2',B2(:,i)
1700 cd write(iout,*) 'CC',CC(:,:,i)
1701 cd write(iout,*) 'DD',DD(:,:,i)
1702 cd write(iout,*) 'EE',EE(:,:,i)
1704 cd call check_vecgrad
1706 if (icheckgrad.eq.1) then
1708 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1710 dc_norm(k,i)=dc(k,i)*fac
1712 c write (iout,*) 'i',i,' fac',fac
1715 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1716 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1717 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1718 cd if (wel_loc.gt.0.0d0) then
1719 if (icheckgrad.eq.1) then
1720 call vec_and_deriv_test
1727 cd write (iout,*) 'i=',i
1729 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1732 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1733 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1746 cd print '(a)','Enter EELEC'
1747 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1749 gel_loc_loc(i)=0.0d0
1752 do i=iatel_s,iatel_e
1753 if (itel(i).eq.0) goto 1215
1757 dx_normi=dc_norm(1,i)
1758 dy_normi=dc_norm(2,i)
1759 dz_normi=dc_norm(3,i)
1760 xmedi=c(1,i)+0.5d0*dxi
1761 ymedi=c(2,i)+0.5d0*dyi
1762 zmedi=c(3,i)+0.5d0*dzi
1764 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1765 do j=ielstart(i),ielend(i)
1766 if (itel(j).eq.0) goto 1216
1770 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1771 aaa=app(iteli,itelj)
1772 bbb=bpp(iteli,itelj)
1773 C Diagnostics only!!!
1779 ael6i=ael6(iteli,itelj)
1780 ael3i=ael3(iteli,itelj)
1784 dx_normj=dc_norm(1,j)
1785 dy_normj=dc_norm(2,j)
1786 dz_normj=dc_norm(3,j)
1787 xj=c(1,j)+0.5D0*dxj-xmedi
1788 yj=c(2,j)+0.5D0*dyj-ymedi
1789 zj=c(3,j)+0.5D0*dzj-zmedi
1790 rij=xj*xj+yj*yj+zj*zj
1796 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1797 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1798 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1799 fac=cosa-3.0D0*cosb*cosg
1801 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1802 if (j.eq.i+2) ev1=scal_el*ev1
1807 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1810 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1811 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1812 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1815 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1816 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1817 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1818 cd & xmedi,ymedi,zmedi,xj,yj,zj
1820 C Calculate contributions to the Cartesian gradient.
1823 facvdw=-6*rrmij*(ev1+evdwij)
1824 facel=-3*rrmij*(el1+eesij)
1831 * Radial derivatives. First process both termini of the fragment (i,j)
1838 gelc(k,i)=gelc(k,i)+ghalf
1839 gelc(k,j)=gelc(k,j)+ghalf
1842 * Loop over residues i+1 thru j-1.
1846 gelc(l,k)=gelc(l,k)+ggg(l)
1854 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1855 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1858 * Loop over residues i+1 thru j-1.
1862 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1869 fac=-3*rrmij*(facvdw+facvdw+facel)
1875 * Radial derivatives. First process both termini of the fragment (i,j)
1882 gelc(k,i)=gelc(k,i)+ghalf
1883 gelc(k,j)=gelc(k,j)+ghalf
1886 * Loop over residues i+1 thru j-1.
1890 gelc(l,k)=gelc(l,k)+ggg(l)
1897 ecosa=2.0D0*fac3*fac1+fac4
1900 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1901 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1903 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1904 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1906 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1907 cd & (dcosg(k),k=1,3)
1909 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1913 gelc(k,i)=gelc(k,i)+ghalf
1914 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1915 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1916 gelc(k,j)=gelc(k,j)+ghalf
1917 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1918 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1922 gelc(l,k)=gelc(l,k)+ggg(l)
1927 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1928 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
1929 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
1931 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
1932 C energy of a peptide unit is assumed in the form of a second-order
1933 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
1934 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
1935 C are computed for EVERY pair of non-contiguous peptide groups.
1937 if (j.lt.nres-1) then
1948 muij(kkk)=mu(k,i)*mu(l,j)
1951 cd write (iout,*) 'EELEC: i',i,' j',j
1952 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
1953 cd write(iout,*) 'muij',muij
1954 ury=scalar(uy(1,i),erij)
1955 urz=scalar(uz(1,i),erij)
1956 vry=scalar(uy(1,j),erij)
1957 vrz=scalar(uz(1,j),erij)
1958 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
1959 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
1960 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
1961 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
1962 C For diagnostics only
1967 fac=dsqrt(-ael6i)*r3ij
1968 cd write (2,*) 'fac=',fac
1969 C For diagnostics only
1975 cd write (iout,'(4i5,4f10.5)')
1976 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
1977 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
1978 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
1979 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
1980 cd write (iout,'(4f10.5)')
1981 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
1982 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
1983 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
1984 cd write (iout,'(2i3,9f10.5/)') i,j,
1985 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
1987 C Derivatives of the elements of A in virtual-bond vectors
1988 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
1995 uryg(k,1)=scalar(erder(1,k),uy(1,i))
1996 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
1997 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
1998 urzg(k,1)=scalar(erder(1,k),uz(1,i))
1999 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2000 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2001 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2002 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2003 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2004 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2005 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2006 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2016 C Compute radial contributions to the gradient
2038 C Add the contributions coming from er
2041 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2042 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2043 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2044 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2047 C Derivatives in DC(i)
2048 ghalf1=0.5d0*agg(k,1)
2049 ghalf2=0.5d0*agg(k,2)
2050 ghalf3=0.5d0*agg(k,3)
2051 ghalf4=0.5d0*agg(k,4)
2052 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2053 & -3.0d0*uryg(k,2)*vry)+ghalf1
2054 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2055 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2056 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2057 & -3.0d0*urzg(k,2)*vry)+ghalf3
2058 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2059 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2060 C Derivatives in DC(i+1)
2061 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2062 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2063 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2064 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2065 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2066 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2067 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2068 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2069 C Derivatives in DC(j)
2070 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2071 & -3.0d0*vryg(k,2)*ury)+ghalf1
2072 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2073 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2074 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2075 & -3.0d0*vryg(k,2)*urz)+ghalf3
2076 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2077 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2078 C Derivatives in DC(j+1) or DC(nres-1)
2079 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2080 & -3.0d0*vryg(k,3)*ury)
2081 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2082 & -3.0d0*vrzg(k,3)*ury)
2083 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2084 & -3.0d0*vryg(k,3)*urz)
2085 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2086 & -3.0d0*vrzg(k,3)*urz)
2091 C Derivatives in DC(i+1)
2092 cd aggi1(k,1)=agg(k,1)
2093 cd aggi1(k,2)=agg(k,2)
2094 cd aggi1(k,3)=agg(k,3)
2095 cd aggi1(k,4)=agg(k,4)
2096 C Derivatives in DC(j)
2101 C Derivatives in DC(j+1)
2106 if (j.eq.nres-1 .and. i.lt.j-2) then
2108 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2109 cd aggj1(k,l)=agg(k,l)
2115 C Check the loc-el terms by numerical integration
2125 aggi(k,l)=-aggi(k,l)
2126 aggi1(k,l)=-aggi1(k,l)
2127 aggj(k,l)=-aggj(k,l)
2128 aggj1(k,l)=-aggj1(k,l)
2131 if (j.lt.nres-1) then
2137 aggi(k,l)=-aggi(k,l)
2138 aggi1(k,l)=-aggi1(k,l)
2139 aggj(k,l)=-aggj(k,l)
2140 aggj1(k,l)=-aggj1(k,l)
2151 aggi(k,l)=-aggi(k,l)
2152 aggi1(k,l)=-aggi1(k,l)
2153 aggj(k,l)=-aggj(k,l)
2154 aggj1(k,l)=-aggj1(k,l)
2160 IF (wel_loc.gt.0.0d0) THEN
2161 C Contribution to the local-electrostatic energy coming from the i-j pair
2162 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2164 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2165 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2166 eel_loc=eel_loc+eel_loc_ij
2167 C Partial derivatives in virtual-bond dihedral angles gamma
2170 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2171 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2172 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2173 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2174 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2175 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2176 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2177 cd write(iout,*) 'agg ',agg
2178 cd write(iout,*) 'aggi ',aggi
2179 cd write(iout,*) 'aggi1',aggi1
2180 cd write(iout,*) 'aggj ',aggj
2181 cd write(iout,*) 'aggj1',aggj1
2183 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2185 ggg(l)=agg(l,1)*muij(1)+
2186 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2190 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2193 C Remaining derivatives of eello
2195 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2196 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2197 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2198 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2199 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2200 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2201 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2202 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2206 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2207 C Contributions from turns
2212 call eturn34(i,j,eello_turn3,eello_turn4)
2214 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2215 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2217 C Calculate the contact function. The ith column of the array JCONT will
2218 C contain the numbers of atoms that make contacts with the atom I (of numbers
2219 C greater than I). The arrays FACONT and GACONT will contain the values of
2220 C the contact function and its derivative.
2221 c r0ij=1.02D0*rpp(iteli,itelj)
2222 c r0ij=1.11D0*rpp(iteli,itelj)
2223 r0ij=2.20D0*rpp(iteli,itelj)
2224 c r0ij=1.55D0*rpp(iteli,itelj)
2225 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2226 if (fcont.gt.0.0D0) then
2227 num_conti=num_conti+1
2228 if (num_conti.gt.maxconts) then
2229 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2230 & ' will skip next contacts for this conf.'
2232 jcont_hb(num_conti,i)=j
2233 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2234 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2235 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2237 d_cont(num_conti,i)=rij
2238 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2239 C --- Electrostatic-interaction matrix ---
2240 a_chuj(1,1,num_conti,i)=a22
2241 a_chuj(1,2,num_conti,i)=a23
2242 a_chuj(2,1,num_conti,i)=a32
2243 a_chuj(2,2,num_conti,i)=a33
2244 C --- Gradient of rij
2246 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2249 c a_chuj(1,1,num_conti,i)=-0.61d0
2250 c a_chuj(1,2,num_conti,i)= 0.4d0
2251 c a_chuj(2,1,num_conti,i)= 0.65d0
2252 c a_chuj(2,2,num_conti,i)= 0.50d0
2253 c else if (i.eq.2) then
2254 c a_chuj(1,1,num_conti,i)= 0.0d0
2255 c a_chuj(1,2,num_conti,i)= 0.0d0
2256 c a_chuj(2,1,num_conti,i)= 0.0d0
2257 c a_chuj(2,2,num_conti,i)= 0.0d0
2259 C --- and its gradients
2260 cd write (iout,*) 'i',i,' j',j
2262 cd write (iout,*) 'iii 1 kkk',kkk
2263 cd write (iout,*) agg(kkk,:)
2266 cd write (iout,*) 'iii 2 kkk',kkk
2267 cd write (iout,*) aggi(kkk,:)
2270 cd write (iout,*) 'iii 3 kkk',kkk
2271 cd write (iout,*) aggi1(kkk,:)
2274 cd write (iout,*) 'iii 4 kkk',kkk
2275 cd write (iout,*) aggj(kkk,:)
2278 cd write (iout,*) 'iii 5 kkk',kkk
2279 cd write (iout,*) aggj1(kkk,:)
2286 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2287 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2288 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2289 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2290 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2292 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2298 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2299 C Calculate contact energies
2301 wij=cosa-3.0D0*cosb*cosg
2304 c fac3=dsqrt(-ael6i)/r0ij**3
2305 fac3=dsqrt(-ael6i)*r3ij
2306 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2307 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2309 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2310 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2311 C Diagnostics. Comment out or remove after debugging!
2312 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2313 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2314 c ees0m(num_conti,i)=0.0D0
2316 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2317 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2318 facont_hb(num_conti,i)=fcont
2320 C Angular derivatives of the contact function
2321 ees0pij1=fac3/ees0pij
2322 ees0mij1=fac3/ees0mij
2323 fac3p=-3.0D0*fac3*rrmij
2324 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2325 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2327 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2328 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2329 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2330 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2331 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2332 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2333 ecosap=ecosa1+ecosa2
2334 ecosbp=ecosb1+ecosb2
2335 ecosgp=ecosg1+ecosg2
2336 ecosam=ecosa1-ecosa2
2337 ecosbm=ecosb1-ecosb2
2338 ecosgm=ecosg1-ecosg2
2347 fprimcont=fprimcont/rij
2348 cd facont_hb(num_conti,i)=1.0D0
2349 C Following line is for diagnostics.
2352 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2353 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2356 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2357 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2359 gggp(1)=gggp(1)+ees0pijp*xj
2360 gggp(2)=gggp(2)+ees0pijp*yj
2361 gggp(3)=gggp(3)+ees0pijp*zj
2362 gggm(1)=gggm(1)+ees0mijp*xj
2363 gggm(2)=gggm(2)+ees0mijp*yj
2364 gggm(3)=gggm(3)+ees0mijp*zj
2365 C Derivatives due to the contact function
2366 gacont_hbr(1,num_conti,i)=fprimcont*xj
2367 gacont_hbr(2,num_conti,i)=fprimcont*yj
2368 gacont_hbr(3,num_conti,i)=fprimcont*zj
2370 ghalfp=0.5D0*gggp(k)
2371 ghalfm=0.5D0*gggm(k)
2372 gacontp_hb1(k,num_conti,i)=ghalfp
2373 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2374 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2375 gacontp_hb2(k,num_conti,i)=ghalfp
2376 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2377 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2378 gacontp_hb3(k,num_conti,i)=gggp(k)
2379 gacontm_hb1(k,num_conti,i)=ghalfm
2380 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2381 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2382 gacontm_hb2(k,num_conti,i)=ghalfm
2383 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2384 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2385 gacontm_hb3(k,num_conti,i)=gggm(k)
2388 C Diagnostics. Comment out or remove after debugging!
2390 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2391 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2392 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2393 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2394 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2395 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2398 endif ! num_conti.le.maxconts
2403 num_cont_hb(i)=num_conti
2407 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2408 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2410 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2411 ccc eel_loc=eel_loc+eello_turn3
2414 C-----------------------------------------------------------------------------
2415 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2416 C Third- and fourth-order contributions from turns
2417 implicit real*8 (a-h,o-z)
2418 include 'DIMENSIONS'
2419 include 'sizesclu.dat'
2420 include 'COMMON.IOUNITS'
2421 include 'COMMON.GEO'
2422 include 'COMMON.VAR'
2423 include 'COMMON.LOCAL'
2424 include 'COMMON.CHAIN'
2425 include 'COMMON.DERIV'
2426 include 'COMMON.INTERACT'
2427 include 'COMMON.CONTACTS'
2428 include 'COMMON.TORSION'
2429 include 'COMMON.VECTORS'
2430 include 'COMMON.FFIELD'
2432 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2433 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2434 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2435 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2436 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2437 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2439 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2441 C Third-order contributions
2448 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2449 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2450 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2451 call transpose2(auxmat(1,1),auxmat1(1,1))
2452 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2453 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2454 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2455 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2456 cd & ' eello_turn3_num',4*eello_turn3_num
2458 C Derivatives in gamma(i)
2459 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2460 call transpose2(auxmat2(1,1),pizda(1,1))
2461 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2462 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2463 C Derivatives in gamma(i+1)
2464 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2465 call transpose2(auxmat2(1,1),pizda(1,1))
2466 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2467 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2468 & +0.5d0*(pizda(1,1)+pizda(2,2))
2469 C Cartesian derivatives
2471 a_temp(1,1)=aggi(l,1)
2472 a_temp(1,2)=aggi(l,2)
2473 a_temp(2,1)=aggi(l,3)
2474 a_temp(2,2)=aggi(l,4)
2475 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2476 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2477 & +0.5d0*(pizda(1,1)+pizda(2,2))
2478 a_temp(1,1)=aggi1(l,1)
2479 a_temp(1,2)=aggi1(l,2)
2480 a_temp(2,1)=aggi1(l,3)
2481 a_temp(2,2)=aggi1(l,4)
2482 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2483 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2484 & +0.5d0*(pizda(1,1)+pizda(2,2))
2485 a_temp(1,1)=aggj(l,1)
2486 a_temp(1,2)=aggj(l,2)
2487 a_temp(2,1)=aggj(l,3)
2488 a_temp(2,2)=aggj(l,4)
2489 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2490 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2491 & +0.5d0*(pizda(1,1)+pizda(2,2))
2492 a_temp(1,1)=aggj1(l,1)
2493 a_temp(1,2)=aggj1(l,2)
2494 a_temp(2,1)=aggj1(l,3)
2495 a_temp(2,2)=aggj1(l,4)
2496 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2497 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2498 & +0.5d0*(pizda(1,1)+pizda(2,2))
2501 else if (j.eq.i+3) then
2502 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2504 C Fourth-order contributions
2512 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2513 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2514 iti1=itortyp(itype(i+1))
2515 iti2=itortyp(itype(i+2))
2516 iti3=itortyp(itype(i+3))
2517 call transpose2(EUg(1,1,i+1),e1t(1,1))
2518 call transpose2(Eug(1,1,i+2),e2t(1,1))
2519 call transpose2(Eug(1,1,i+3),e3t(1,1))
2520 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2521 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2522 s1=scalar2(b1(1,iti2),auxvec(1))
2523 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2524 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2525 s2=scalar2(b1(1,iti1),auxvec(1))
2526 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2527 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2528 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2529 eello_turn4=eello_turn4-(s1+s2+s3)
2530 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2531 cd & ' eello_turn4_num',8*eello_turn4_num
2532 C Derivatives in gamma(i)
2534 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2535 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2536 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2537 s1=scalar2(b1(1,iti2),auxvec(1))
2538 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2539 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2540 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2541 C Derivatives in gamma(i+1)
2542 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2543 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2544 s2=scalar2(b1(1,iti1),auxvec(1))
2545 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2546 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2547 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2548 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2549 C Derivatives in gamma(i+2)
2550 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2551 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2552 s1=scalar2(b1(1,iti2),auxvec(1))
2553 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2554 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2555 s2=scalar2(b1(1,iti1),auxvec(1))
2556 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2557 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2558 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2559 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2560 C Cartesian derivatives
2561 C Derivatives of this turn contributions in DC(i+2)
2562 if (j.lt.nres-1) then
2564 a_temp(1,1)=agg(l,1)
2565 a_temp(1,2)=agg(l,2)
2566 a_temp(2,1)=agg(l,3)
2567 a_temp(2,2)=agg(l,4)
2568 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2569 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2570 s1=scalar2(b1(1,iti2),auxvec(1))
2571 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2572 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2573 s2=scalar2(b1(1,iti1),auxvec(1))
2574 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2575 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2576 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2578 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2581 C Remaining derivatives of this turn contribution
2583 a_temp(1,1)=aggi(l,1)
2584 a_temp(1,2)=aggi(l,2)
2585 a_temp(2,1)=aggi(l,3)
2586 a_temp(2,2)=aggi(l,4)
2587 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2588 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2589 s1=scalar2(b1(1,iti2),auxvec(1))
2590 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2591 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2592 s2=scalar2(b1(1,iti1),auxvec(1))
2593 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2594 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2595 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2596 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2597 a_temp(1,1)=aggi1(l,1)
2598 a_temp(1,2)=aggi1(l,2)
2599 a_temp(2,1)=aggi1(l,3)
2600 a_temp(2,2)=aggi1(l,4)
2601 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2602 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2603 s1=scalar2(b1(1,iti2),auxvec(1))
2604 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2605 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2606 s2=scalar2(b1(1,iti1),auxvec(1))
2607 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2608 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2609 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2610 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2611 a_temp(1,1)=aggj(l,1)
2612 a_temp(1,2)=aggj(l,2)
2613 a_temp(2,1)=aggj(l,3)
2614 a_temp(2,2)=aggj(l,4)
2615 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2616 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2617 s1=scalar2(b1(1,iti2),auxvec(1))
2618 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2619 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2620 s2=scalar2(b1(1,iti1),auxvec(1))
2621 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2622 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2623 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2624 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2625 a_temp(1,1)=aggj1(l,1)
2626 a_temp(1,2)=aggj1(l,2)
2627 a_temp(2,1)=aggj1(l,3)
2628 a_temp(2,2)=aggj1(l,4)
2629 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2630 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2631 s1=scalar2(b1(1,iti2),auxvec(1))
2632 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2633 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2634 s2=scalar2(b1(1,iti1),auxvec(1))
2635 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2636 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2637 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2638 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2644 C-----------------------------------------------------------------------------
2645 subroutine vecpr(u,v,w)
2646 implicit real*8(a-h,o-z)
2647 dimension u(3),v(3),w(3)
2648 w(1)=u(2)*v(3)-u(3)*v(2)
2649 w(2)=-u(1)*v(3)+u(3)*v(1)
2650 w(3)=u(1)*v(2)-u(2)*v(1)
2653 C-----------------------------------------------------------------------------
2654 subroutine unormderiv(u,ugrad,unorm,ungrad)
2655 C This subroutine computes the derivatives of a normalized vector u, given
2656 C the derivatives computed without normalization conditions, ugrad. Returns
2659 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2660 double precision vec(3)
2661 double precision scalar
2663 c write (2,*) 'ugrad',ugrad
2666 vec(i)=scalar(ugrad(1,i),u(1))
2668 c write (2,*) 'vec',vec
2671 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2674 c write (2,*) 'ungrad',ungrad
2677 C-----------------------------------------------------------------------------
2678 subroutine escp(evdw2,evdw2_14)
2680 C This subroutine calculates the excluded-volume interaction energy between
2681 C peptide-group centers and side chains and its gradient in virtual-bond and
2682 C side-chain vectors.
2684 implicit real*8 (a-h,o-z)
2685 include 'DIMENSIONS'
2686 include 'sizesclu.dat'
2687 include 'COMMON.GEO'
2688 include 'COMMON.VAR'
2689 include 'COMMON.LOCAL'
2690 include 'COMMON.CHAIN'
2691 include 'COMMON.DERIV'
2692 include 'COMMON.INTERACT'
2693 include 'COMMON.FFIELD'
2694 include 'COMMON.IOUNITS'
2698 cd print '(a)','Enter ESCP'
2699 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2700 c & ' scal14',scal14
2701 do i=iatscp_s,iatscp_e
2703 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2704 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2705 if (iteli.eq.0) goto 1225
2706 xi=0.5D0*(c(1,i)+c(1,i+1))
2707 yi=0.5D0*(c(2,i)+c(2,i+1))
2708 zi=0.5D0*(c(3,i)+c(3,i+1))
2710 do iint=1,nscp_gr(i)
2712 do j=iscpstart(i,iint),iscpend(i,iint)
2713 itypj=iabs(itype(j))
2714 C Uncomment following three lines for SC-p interactions
2718 C Uncomment following three lines for Ca-p interactions
2722 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2724 e1=fac*fac*aad(itypj,iteli)
2725 e2=fac*bad(itypj,iteli)
2726 if (iabs(j-i) .le. 2) then
2729 evdw2_14=evdw2_14+e1+e2
2732 c write (iout,*) i,j,evdwij
2736 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2738 fac=-(evdwij+e1)*rrij
2743 cd write (iout,*) 'j<i'
2744 C Uncomment following three lines for SC-p interactions
2746 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2749 cd write (iout,*) 'j>i'
2752 C Uncomment following line for SC-p interactions
2753 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2757 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2761 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2762 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2765 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2775 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2776 gradx_scp(j,i)=expon*gradx_scp(j,i)
2779 C******************************************************************************
2783 C To save time the factor EXPON has been extracted from ALL components
2784 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2787 C******************************************************************************
2790 C--------------------------------------------------------------------------
2791 subroutine edis(ehpb)
2793 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2795 implicit real*8 (a-h,o-z)
2796 include 'DIMENSIONS'
2797 include 'COMMON.SBRIDGE'
2798 include 'COMMON.CHAIN'
2799 include 'COMMON.DERIV'
2800 include 'COMMON.VAR'
2801 include 'COMMON.INTERACT'
2802 include 'COMMON.IOUNITS'
2805 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2806 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2807 if (link_end.eq.0) return
2808 do i=link_start,link_end
2809 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2810 C CA-CA distance used in regularization of structure.
2813 C iii and jjj point to the residues for which the distance is assigned.
2814 if (ii.gt.nres) then
2821 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2822 c & dhpb(i),dhpb1(i),forcon(i)
2823 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2824 C distance and angle dependent SS bond potential.
2825 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2826 & iabs( itype(jjj)).eq.1) then
2827 call ssbond_ene(iii,jjj,eij)
2829 cd write (iout,*) "eij",eij
2830 else if (ii.gt.nres .and. jj.gt.nres) then
2831 c Restraints from contact prediction
2833 if (dhpb1(i).gt.0.0d0) then
2834 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2835 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2836 c write (iout,*) "beta nmr",
2837 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2841 C Get the force constant corresponding to this distance.
2843 C Calculate the contribution to energy.
2844 ehpb=ehpb+waga*rdis*rdis
2845 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2847 C Evaluate gradient.
2852 ggg(j)=fac*(c(j,jj)-c(j,ii))
2855 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2856 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2859 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2860 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2863 C Calculate the distance between the two points and its difference from the
2866 if (dhpb1(i).gt.0.0d0) then
2867 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2868 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2869 c write (iout,*) "alph nmr",
2870 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2873 C Get the force constant corresponding to this distance.
2875 C Calculate the contribution to energy.
2876 ehpb=ehpb+waga*rdis*rdis
2877 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2879 C Evaluate gradient.
2883 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2884 cd & ' waga=',waga,' fac=',fac
2886 ggg(j)=fac*(c(j,jj)-c(j,ii))
2888 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2889 C If this is a SC-SC distance, we need to calculate the contributions to the
2890 C Cartesian gradient in the SC vectors (ghpbx).
2893 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2894 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2898 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2899 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2906 C--------------------------------------------------------------------------
2907 subroutine ssbond_ene(i,j,eij)
2909 C Calculate the distance and angle dependent SS-bond potential energy
2910 C using a free-energy function derived based on RHF/6-31G** ab initio
2911 C calculations of diethyl disulfide.
2913 C A. Liwo and U. Kozlowska, 11/24/03
2915 implicit real*8 (a-h,o-z)
2916 include 'DIMENSIONS'
2917 include 'sizesclu.dat'
2918 include 'COMMON.SBRIDGE'
2919 include 'COMMON.CHAIN'
2920 include 'COMMON.DERIV'
2921 include 'COMMON.LOCAL'
2922 include 'COMMON.INTERACT'
2923 include 'COMMON.VAR'
2924 include 'COMMON.IOUNITS'
2925 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2926 itypi=iabs(itype(i))
2930 dxi=dc_norm(1,nres+i)
2931 dyi=dc_norm(2,nres+i)
2932 dzi=dc_norm(3,nres+i)
2933 dsci_inv=dsc_inv(itypi)
2934 itypj=iabs(itype(j))
2935 dscj_inv=dsc_inv(itypj)
2939 dxj=dc_norm(1,nres+j)
2940 dyj=dc_norm(2,nres+j)
2941 dzj=dc_norm(3,nres+j)
2942 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2947 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2948 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2949 om12=dxi*dxj+dyi*dyj+dzi*dzj
2951 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2952 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2958 deltat12=om2-om1+2.0d0
2960 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2961 & +akct*deltad*deltat12
2962 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2963 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2964 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2965 c & " deltat12",deltat12," eij",eij
2966 ed=2*akcm*deltad+akct*deltat12
2968 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
2969 eom1=-2*akth*deltat1-pom1-om2*pom2
2970 eom2= 2*akth*deltat2+pom1-om1*pom2
2973 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2976 ghpbx(k,i)=ghpbx(k,i)-gg(k)
2977 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
2978 ghpbx(k,j)=ghpbx(k,j)+gg(k)
2979 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
2982 C Calculate the components of the gradient in DC and X
2986 ghpbc(l,k)=ghpbc(l,k)+gg(l)
2991 C--------------------------------------------------------------------------
2992 subroutine ebond(estr)
2994 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
2996 implicit real*8 (a-h,o-z)
2997 include 'DIMENSIONS'
2998 include 'COMMON.LOCAL'
2999 include 'COMMON.GEO'
3000 include 'COMMON.INTERACT'
3001 include 'COMMON.DERIV'
3002 include 'COMMON.VAR'
3003 include 'COMMON.CHAIN'
3004 include 'COMMON.IOUNITS'
3005 include 'COMMON.NAMES'
3006 include 'COMMON.FFIELD'
3007 include 'COMMON.CONTROL'
3008 double precision u(3),ud(3)
3011 diff = vbld(i)-vbldp0
3012 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3015 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3020 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3027 diff=vbld(i+nres)-vbldsc0(1,iti)
3028 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3029 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3030 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3032 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3036 diff=vbld(i+nres)-vbldsc0(j,iti)
3037 ud(j)=aksc(j,iti)*diff
3038 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3052 uprod2=uprod2*u(k)*u(k)
3056 usumsqder=usumsqder+ud(j)*uprod2
3058 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3059 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3060 estr=estr+uprod/usum
3062 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3070 C--------------------------------------------------------------------------
3071 subroutine ebend(etheta)
3073 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3074 C angles gamma and its derivatives in consecutive thetas and gammas.
3076 implicit real*8 (a-h,o-z)
3077 include 'DIMENSIONS'
3078 include 'sizesclu.dat'
3079 include 'COMMON.LOCAL'
3080 include 'COMMON.GEO'
3081 include 'COMMON.INTERACT'
3082 include 'COMMON.DERIV'
3083 include 'COMMON.VAR'
3084 include 'COMMON.CHAIN'
3085 include 'COMMON.IOUNITS'
3086 include 'COMMON.NAMES'
3087 include 'COMMON.FFIELD'
3088 common /calcthet/ term1,term2,termm,diffak,ratak,
3089 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3090 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3091 double precision y(2),z(2)
3093 time11=dexp(-2*time)
3096 c write (iout,*) "nres",nres
3097 c write (*,'(a,i2)') 'EBEND ICG=',icg
3098 c write (iout,*) ithet_start,ithet_end
3099 do i=ithet_start,ithet_end
3100 C Zero the energy function and its derivative at 0 or pi.
3101 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3103 ichir1=isign(1,itype(i-2))
3104 ichir2=isign(1,itype(i))
3105 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3106 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3107 if (itype(i-1).eq.10) then
3108 itype1=isign(10,itype(i-2))
3109 ichir11=isign(1,itype(i-2))
3110 ichir12=isign(1,itype(i-2))
3111 itype2=isign(10,itype(i))
3112 ichir21=isign(1,itype(i))
3113 ichir22=isign(1,itype(i))
3115 c if (i.gt.ithet_start .and.
3116 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3117 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3125 c if (i.lt.nres .and. itel(i).ne.0) then
3137 call proc_proc(phii,icrc)
3138 if (icrc.eq.1) phii=150.0
3152 call proc_proc(phii1,icrc)
3153 if (icrc.eq.1) phii1=150.0
3165 C Calculate the "mean" value of theta from the part of the distribution
3166 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3167 C In following comments this theta will be referred to as t_c.
3168 thet_pred_mean=0.0d0
3170 athetk=athet(k,it,ichir1,ichir2)
3171 bthetk=bthet(k,it,ichir1,ichir2)
3173 athetk=athet(k,itype1,ichir11,ichir12)
3174 bthetk=bthet(k,itype2,ichir21,ichir22)
3176 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3178 c write (iout,*) "thet_pred_mean",thet_pred_mean
3179 dthett=thet_pred_mean*ssd
3180 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3181 c write (iout,*) "thet_pred_mean",thet_pred_mean
3182 C Derivatives of the "mean" values in gamma1 and gamma2.
3183 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3184 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3185 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3186 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3188 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3189 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3190 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3191 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3193 if (theta(i).gt.pi-delta) then
3194 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3196 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3197 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3198 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3200 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3202 else if (theta(i).lt.delta) then
3203 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3204 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3205 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3207 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3208 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3211 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3214 etheta=etheta+ethetai
3215 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3216 c & rad2deg*phii,rad2deg*phii1,ethetai
3217 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3218 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3219 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3222 C Ufff.... We've done all this!!!
3225 C---------------------------------------------------------------------------
3226 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3228 implicit real*8 (a-h,o-z)
3229 include 'DIMENSIONS'
3230 include 'COMMON.LOCAL'
3231 include 'COMMON.IOUNITS'
3232 common /calcthet/ term1,term2,termm,diffak,ratak,
3233 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3234 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3235 C Calculate the contributions to both Gaussian lobes.
3236 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3237 C The "polynomial part" of the "standard deviation" of this part of
3241 sig=sig*thet_pred_mean+polthet(j,it)
3243 C Derivative of the "interior part" of the "standard deviation of the"
3244 C gamma-dependent Gaussian lobe in t_c.
3245 sigtc=3*polthet(3,it)
3247 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3250 C Set the parameters of both Gaussian lobes of the distribution.
3251 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3252 fac=sig*sig+sigc0(it)
3255 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3256 sigsqtc=-4.0D0*sigcsq*sigtc
3257 c print *,i,sig,sigtc,sigsqtc
3258 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3259 sigtc=-sigtc/(fac*fac)
3260 C Following variable is sigma(t_c)**(-2)
3261 sigcsq=sigcsq*sigcsq
3263 sig0inv=1.0D0/sig0i**2
3264 delthec=thetai-thet_pred_mean
3265 delthe0=thetai-theta0i
3266 term1=-0.5D0*sigcsq*delthec*delthec
3267 term2=-0.5D0*sig0inv*delthe0*delthe0
3268 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3269 C NaNs in taking the logarithm. We extract the largest exponent which is added
3270 C to the energy (this being the log of the distribution) at the end of energy
3271 C term evaluation for this virtual-bond angle.
3272 if (term1.gt.term2) then
3274 term2=dexp(term2-termm)
3278 term1=dexp(term1-termm)
3281 C The ratio between the gamma-independent and gamma-dependent lobes of
3282 C the distribution is a Gaussian function of thet_pred_mean too.
3283 diffak=gthet(2,it)-thet_pred_mean
3284 ratak=diffak/gthet(3,it)**2
3285 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3286 C Let's differentiate it in thet_pred_mean NOW.
3288 C Now put together the distribution terms to make complete distribution.
3289 termexp=term1+ak*term2
3290 termpre=sigc+ak*sig0i
3291 C Contribution of the bending energy from this theta is just the -log of
3292 C the sum of the contributions from the two lobes and the pre-exponential
3293 C factor. Simple enough, isn't it?
3294 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3295 C NOW the derivatives!!!
3296 C 6/6/97 Take into account the deformation.
3297 E_theta=(delthec*sigcsq*term1
3298 & +ak*delthe0*sig0inv*term2)/termexp
3299 E_tc=((sigtc+aktc*sig0i)/termpre
3300 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3301 & aktc*term2)/termexp)
3304 c-----------------------------------------------------------------------------
3305 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3306 implicit real*8 (a-h,o-z)
3307 include 'DIMENSIONS'
3308 include 'COMMON.LOCAL'
3309 include 'COMMON.IOUNITS'
3310 common /calcthet/ term1,term2,termm,diffak,ratak,
3311 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3312 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3313 delthec=thetai-thet_pred_mean
3314 delthe0=thetai-theta0i
3315 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3316 t3 = thetai-thet_pred_mean
3320 t14 = t12+t6*sigsqtc
3322 t21 = thetai-theta0i
3328 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3329 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3330 & *(-t12*t9-ak*sig0inv*t27)
3334 C--------------------------------------------------------------------------
3335 subroutine ebend(etheta)
3337 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3338 C angles gamma and its derivatives in consecutive thetas and gammas.
3339 C ab initio-derived potentials from
3340 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3342 implicit real*8 (a-h,o-z)
3343 include 'DIMENSIONS'
3344 include 'COMMON.LOCAL'
3345 include 'COMMON.GEO'
3346 include 'COMMON.INTERACT'
3347 include 'COMMON.DERIV'
3348 include 'COMMON.VAR'
3349 include 'COMMON.CHAIN'
3350 include 'COMMON.IOUNITS'
3351 include 'COMMON.NAMES'
3352 include 'COMMON.FFIELD'
3353 include 'COMMON.CONTROL'
3354 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3355 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3356 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3357 & sinph1ph2(maxdouble,maxdouble)
3358 logical lprn /.false./, lprn1 /.false./
3360 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3361 do i=ithet_start,ithet_end
3365 theti2=0.5d0*theta(i)
3366 CC Ta zmiana jest niewlasciwa
3367 ityp2=ithetyp(iabs(itype(i-1)))
3369 coskt(k)=dcos(k*theti2)
3370 sinkt(k)=dsin(k*theti2)
3375 if (phii.ne.phii) phii=150.0
3379 ityp1=ithetyp(iabs(itype(i-2)))
3381 cosph1(k)=dcos(k*phii)
3382 sinph1(k)=dsin(k*phii)
3395 if (phii1.ne.phii1) phii1=150.0
3400 ityp3=ithetyp(iabs(itype(i)))
3402 cosph2(k)=dcos(k*phii1)
3403 sinph2(k)=dsin(k*phii1)
3413 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3414 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3416 ethetai=aa0thet(ityp1,ityp2,ityp3)
3419 ccl=cosph1(l)*cosph2(k-l)
3420 ssl=sinph1(l)*sinph2(k-l)
3421 scl=sinph1(l)*cosph2(k-l)
3422 csl=cosph1(l)*sinph2(k-l)
3423 cosph1ph2(l,k)=ccl-ssl
3424 cosph1ph2(k,l)=ccl+ssl
3425 sinph1ph2(l,k)=scl+csl
3426 sinph1ph2(k,l)=scl-csl
3430 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3431 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3432 write (iout,*) "coskt and sinkt"
3434 write (iout,*) k,coskt(k),sinkt(k)
3438 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3439 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3442 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3443 & " ethetai",ethetai
3446 write (iout,*) "cosph and sinph"
3448 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3450 write (iout,*) "cosph1ph2 and sinph2ph2"
3453 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3454 & sinph1ph2(l,k),sinph1ph2(k,l)
3457 write(iout,*) "ethetai",ethetai
3461 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3462 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3463 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3464 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3465 ethetai=ethetai+sinkt(m)*aux
3466 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3467 dephii=dephii+k*sinkt(m)*(
3468 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3469 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3470 dephii1=dephii1+k*sinkt(m)*(
3471 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3472 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3474 & write (iout,*) "m",m," k",k," bbthet",
3475 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3476 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3477 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3478 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3482 & write(iout,*) "ethetai",ethetai
3486 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3487 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3488 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3489 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3490 ethetai=ethetai+sinkt(m)*aux
3491 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3492 dephii=dephii+l*sinkt(m)*(
3493 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3494 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3495 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3496 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3497 dephii1=dephii1+(k-l)*sinkt(m)*(
3498 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3499 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3500 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3501 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3503 write (iout,*) "m",m," k",k," l",l," ffthet",
3504 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3505 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3506 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3507 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3508 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3509 & cosph1ph2(k,l)*sinkt(m),
3510 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3516 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3517 & i,theta(i)*rad2deg,phii*rad2deg,
3518 & phii1*rad2deg,ethetai
3519 etheta=etheta+ethetai
3520 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3521 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3522 gloc(nphi+i-2,icg)=wang*dethetai
3528 c-----------------------------------------------------------------------------
3529 subroutine esc(escloc)
3530 C Calculate the local energy of a side chain and its derivatives in the
3531 C corresponding virtual-bond valence angles THETA and the spherical angles
3533 implicit real*8 (a-h,o-z)
3534 include 'DIMENSIONS'
3535 include 'sizesclu.dat'
3536 include 'COMMON.GEO'
3537 include 'COMMON.LOCAL'
3538 include 'COMMON.VAR'
3539 include 'COMMON.INTERACT'
3540 include 'COMMON.DERIV'
3541 include 'COMMON.CHAIN'
3542 include 'COMMON.IOUNITS'
3543 include 'COMMON.NAMES'
3544 include 'COMMON.FFIELD'
3545 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3546 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3547 common /sccalc/ time11,time12,time112,theti,it,nlobit
3550 c write (iout,'(a)') 'ESC'
3551 do i=loc_start,loc_end
3553 if (it.eq.10) goto 1
3554 nlobit=nlob(iabs(it))
3555 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3556 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3557 theti=theta(i+1)-pipol
3561 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3563 if (x(2).gt.pi-delta) then
3567 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3569 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3570 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3572 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3573 & ddersc0(1),dersc(1))
3574 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3575 & ddersc0(3),dersc(3))
3577 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3579 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3580 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3581 & dersc0(2),esclocbi,dersc02)
3582 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3584 call splinthet(x(2),0.5d0*delta,ss,ssd)
3589 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3591 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3592 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3594 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3596 c write (iout,*) escloci
3597 else if (x(2).lt.delta) then
3601 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3603 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3604 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3606 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3607 & ddersc0(1),dersc(1))
3608 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3609 & ddersc0(3),dersc(3))
3611 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3613 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3614 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3615 & dersc0(2),esclocbi,dersc02)
3616 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3621 call splinthet(x(2),0.5d0*delta,ss,ssd)
3623 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3625 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3626 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3628 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3629 c write (iout,*) escloci
3631 call enesc(x,escloci,dersc,ddummy,.false.)
3634 escloc=escloc+escloci
3635 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3637 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3639 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3640 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3645 C---------------------------------------------------------------------------
3646 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3647 implicit real*8 (a-h,o-z)
3648 include 'DIMENSIONS'
3649 include 'COMMON.GEO'
3650 include 'COMMON.LOCAL'
3651 include 'COMMON.IOUNITS'
3652 common /sccalc/ time11,time12,time112,theti,it,nlobit
3653 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3654 double precision contr(maxlob,-1:1)
3656 c write (iout,*) 'it=',it,' nlobit=',nlobit
3660 if (mixed) ddersc(j)=0.0d0
3664 C Because of periodicity of the dependence of the SC energy in omega we have
3665 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3666 C To avoid underflows, first compute & store the exponents.
3674 z(k)=x(k)-censc(k,j,it)
3679 Axk=Axk+gaussc(l,k,j,it)*z(l)
3685 expfac=expfac+Ax(k,j,iii)*z(k)
3693 C As in the case of ebend, we want to avoid underflows in exponentiation and
3694 C subsequent NaNs and INFs in energy calculation.
3695 C Find the largest exponent
3699 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3703 cd print *,'it=',it,' emin=',emin
3705 C Compute the contribution to SC energy and derivatives
3709 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3710 cd print *,'j=',j,' expfac=',expfac
3711 escloc_i=escloc_i+expfac
3713 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3717 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3718 & +gaussc(k,2,j,it))*expfac
3725 dersc(1)=dersc(1)/cos(theti)**2
3726 ddersc(1)=ddersc(1)/cos(theti)**2
3729 escloci=-(dlog(escloc_i)-emin)
3731 dersc(j)=dersc(j)/escloc_i
3735 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3740 C------------------------------------------------------------------------------
3741 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3742 implicit real*8 (a-h,o-z)
3743 include 'DIMENSIONS'
3744 include 'COMMON.GEO'
3745 include 'COMMON.LOCAL'
3746 include 'COMMON.IOUNITS'
3747 common /sccalc/ time11,time12,time112,theti,it,nlobit
3748 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3749 double precision contr(maxlob)
3760 z(k)=x(k)-censc(k,j,it)
3766 Axk=Axk+gaussc(l,k,j,it)*z(l)
3772 expfac=expfac+Ax(k,j)*z(k)
3777 C As in the case of ebend, we want to avoid underflows in exponentiation and
3778 C subsequent NaNs and INFs in energy calculation.
3779 C Find the largest exponent
3782 if (emin.gt.contr(j)) emin=contr(j)
3786 C Compute the contribution to SC energy and derivatives
3790 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3791 escloc_i=escloc_i+expfac
3793 dersc(k)=dersc(k)+Ax(k,j)*expfac
3795 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3796 & +gaussc(1,2,j,it))*expfac
3800 dersc(1)=dersc(1)/cos(theti)**2
3801 dersc12=dersc12/cos(theti)**2
3802 escloci=-(dlog(escloc_i)-emin)
3804 dersc(j)=dersc(j)/escloc_i
3806 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3810 c----------------------------------------------------------------------------------
3811 subroutine esc(escloc)
3812 C Calculate the local energy of a side chain and its derivatives in the
3813 C corresponding virtual-bond valence angles THETA and the spherical angles
3814 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3815 C added by Urszula Kozlowska. 07/11/2007
3817 implicit real*8 (a-h,o-z)
3818 include 'DIMENSIONS'
3819 include 'COMMON.GEO'
3820 include 'COMMON.LOCAL'
3821 include 'COMMON.VAR'
3822 include 'COMMON.SCROT'
3823 include 'COMMON.INTERACT'
3824 include 'COMMON.DERIV'
3825 include 'COMMON.CHAIN'
3826 include 'COMMON.IOUNITS'
3827 include 'COMMON.NAMES'
3828 include 'COMMON.FFIELD'
3829 include 'COMMON.CONTROL'
3830 include 'COMMON.VECTORS'
3831 double precision x_prime(3),y_prime(3),z_prime(3)
3832 & , sumene,dsc_i,dp2_i,x(65),
3833 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3834 & de_dxx,de_dyy,de_dzz,de_dt
3835 double precision s1_t,s1_6_t,s2_t,s2_6_t
3837 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3838 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3839 & dt_dCi(3),dt_dCi1(3)
3840 common /sccalc/ time11,time12,time112,theti,it,nlobit
3843 do i=loc_start,loc_end
3844 costtab(i+1) =dcos(theta(i+1))
3845 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3846 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3847 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3848 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3849 cosfac=dsqrt(cosfac2)
3850 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3851 sinfac=dsqrt(sinfac2)
3853 if (it.eq.10) goto 1
3855 C Compute the axes of tghe local cartesian coordinates system; store in
3856 c x_prime, y_prime and z_prime
3863 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3864 C & dc_norm(3,i+nres)
3866 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3867 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3870 z_prime(j) = -uz(j,i-1)
3873 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3874 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3875 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3876 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3877 c & " xy",scalar(x_prime(1),y_prime(1)),
3878 c & " xz",scalar(x_prime(1),z_prime(1)),
3879 c & " yy",scalar(y_prime(1),y_prime(1)),
3880 c & " yz",scalar(y_prime(1),z_prime(1)),
3881 c & " zz",scalar(z_prime(1),z_prime(1))
3883 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3884 C to local coordinate system. Store in xx, yy, zz.
3890 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3891 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3892 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3893 zz = zz + dsign(1.0,itype(i))*z_prime(j)*dc_norm(j,i+nres)
3901 C Compute the energy of the ith side cbain
3903 c write (2,*) "xx",xx," yy",yy," zz",zz
3906 x(j) = sc_parmin(j,it)
3909 Cc diagnostics - remove later
3911 yy1 = dsin(alph(2))*dcos(omeg(2))
3912 zz1 = -dsin(alph(2))*dsin(omeg(2))
3913 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3914 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3916 C," --- ", xx_w,yy_w,zz_w
3919 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3920 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3922 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3923 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3925 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3926 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3927 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3928 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3929 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3931 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3932 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3933 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3934 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3935 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3937 dsc_i = 0.743d0+x(61)
3939 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3940 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3941 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3942 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3943 s1=(1+x(63))/(0.1d0 + dscp1)
3944 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3945 s2=(1+x(65))/(0.1d0 + dscp2)
3946 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3947 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3948 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3949 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3951 c & dscp1,dscp2,sumene
3952 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3953 escloc = escloc + sumene
3954 c write (2,*) "escloc",escloc
3955 if (.not. calc_grad) goto 1
3958 C This section to check the numerical derivatives of the energy of ith side
3959 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3960 C #define DEBUG in the code to turn it on.
3962 write (2,*) "sumene =",sumene
3966 write (2,*) xx,yy,zz
3967 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3968 de_dxx_num=(sumenep-sumene)/aincr
3970 write (2,*) "xx+ sumene from enesc=",sumenep
3973 write (2,*) xx,yy,zz
3974 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3975 de_dyy_num=(sumenep-sumene)/aincr
3977 write (2,*) "yy+ sumene from enesc=",sumenep
3980 write (2,*) xx,yy,zz
3981 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3982 de_dzz_num=(sumenep-sumene)/aincr
3984 write (2,*) "zz+ sumene from enesc=",sumenep
3985 costsave=cost2tab(i+1)
3986 sintsave=sint2tab(i+1)
3987 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
3988 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
3989 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3990 de_dt_num=(sumenep-sumene)/aincr
3991 write (2,*) " t+ sumene from enesc=",sumenep
3992 cost2tab(i+1)=costsave
3993 sint2tab(i+1)=sintsave
3994 C End of diagnostics section.
3997 C Compute the gradient of esc
3999 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4000 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4001 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4002 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4003 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4004 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4005 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4006 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4007 pom1=(sumene3*sint2tab(i+1)+sumene1)
4008 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4009 pom2=(sumene4*cost2tab(i+1)+sumene2)
4010 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4011 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4012 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4013 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4015 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4016 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4017 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4019 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4020 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4021 & +(pom1+pom2)*pom_dx
4023 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4026 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4027 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4028 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4030 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4031 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4032 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4033 & +x(59)*zz**2 +x(60)*xx*zz
4034 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4035 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4036 & +(pom1-pom2)*pom_dy
4038 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4041 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4042 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4043 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4044 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4045 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4046 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4047 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4048 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4050 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4053 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4054 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4055 & +pom1*pom_dt1+pom2*pom_dt2
4057 write(2,*), "de_dt = ", de_dt,de_dt_num
4061 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4062 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4063 cosfac2xx=cosfac2*xx
4064 sinfac2yy=sinfac2*yy
4066 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4068 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4070 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4071 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4072 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4073 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4074 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4075 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4076 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4077 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4078 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4079 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4083 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4084 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4087 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4088 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4089 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4091 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4092 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4096 dXX_Ctab(k,i)=dXX_Ci(k)
4097 dXX_C1tab(k,i)=dXX_Ci1(k)
4098 dYY_Ctab(k,i)=dYY_Ci(k)
4099 dYY_C1tab(k,i)=dYY_Ci1(k)
4100 dZZ_Ctab(k,i)=dZZ_Ci(k)
4101 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4102 dXX_XYZtab(k,i)=dXX_XYZ(k)
4103 dYY_XYZtab(k,i)=dYY_XYZ(k)
4104 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4108 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4109 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4110 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4111 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4112 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4114 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4115 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4116 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4117 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4118 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4119 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4120 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4121 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4123 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4124 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4126 C to check gradient call subroutine check_grad
4133 c------------------------------------------------------------------------------
4134 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4136 C This procedure calculates two-body contact function g(rij) and its derivative:
4139 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4142 C where x=(rij-r0ij)/delta
4144 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4147 double precision rij,r0ij,eps0ij,fcont,fprimcont
4148 double precision x,x2,x4,delta
4152 if (x.lt.-1.0D0) then
4155 else if (x.le.1.0D0) then
4158 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4159 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4166 c------------------------------------------------------------------------------
4167 subroutine splinthet(theti,delta,ss,ssder)
4168 implicit real*8 (a-h,o-z)
4169 include 'DIMENSIONS'
4170 include 'sizesclu.dat'
4171 include 'COMMON.VAR'
4172 include 'COMMON.GEO'
4175 if (theti.gt.pipol) then
4176 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4178 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4183 c------------------------------------------------------------------------------
4184 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4186 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4187 double precision ksi,ksi2,ksi3,a1,a2,a3
4188 a1=fprim0*delta/(f1-f0)
4194 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4195 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4198 c------------------------------------------------------------------------------
4199 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4201 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4202 double precision ksi,ksi2,ksi3,a1,a2,a3
4207 a2=3*(f1x-f0x)-2*fprim0x*delta
4208 a3=fprim0x*delta-2*(f1x-f0x)
4209 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4212 C-----------------------------------------------------------------------------
4214 C-----------------------------------------------------------------------------
4215 subroutine etor(etors,edihcnstr,fact)
4216 implicit real*8 (a-h,o-z)
4217 include 'DIMENSIONS'
4218 include 'sizesclu.dat'
4219 include 'COMMON.VAR'
4220 include 'COMMON.GEO'
4221 include 'COMMON.LOCAL'
4222 include 'COMMON.TORSION'
4223 include 'COMMON.INTERACT'
4224 include 'COMMON.DERIV'
4225 include 'COMMON.CHAIN'
4226 include 'COMMON.NAMES'
4227 include 'COMMON.IOUNITS'
4228 include 'COMMON.FFIELD'
4229 include 'COMMON.TORCNSTR'
4231 C Set lprn=.true. for debugging
4235 do i=iphi_start,iphi_end
4236 itori=itortyp(itype(i-2))
4237 itori1=itortyp(itype(i-1))
4240 C Proline-Proline pair is a special case...
4241 if (itori.eq.3 .and. itori1.eq.3) then
4242 if (phii.gt.-dwapi3) then
4244 fac=1.0D0/(1.0D0-cosphi)
4245 etorsi=v1(1,3,3)*fac
4246 etorsi=etorsi+etorsi
4247 etors=etors+etorsi-v1(1,3,3)
4248 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4251 v1ij=v1(j+1,itori,itori1)
4252 v2ij=v2(j+1,itori,itori1)
4255 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4256 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4260 v1ij=v1(j,itori,itori1)
4261 v2ij=v2(j,itori,itori1)
4264 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4265 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4269 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4270 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4271 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4272 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4273 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4275 ! 6/20/98 - dihedral angle constraints
4278 itori=idih_constr(i)
4280 difi=pinorm(phii-phi0(i))
4281 if (difi.gt.drange(i)) then
4283 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4284 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4285 else if (difi.lt.-drange(i)) then
4287 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4288 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4290 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4291 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4293 write (iout,*) 'edihcnstr',edihcnstr
4296 c------------------------------------------------------------------------------
4298 subroutine etor(etors,edihcnstr,fact)
4299 implicit real*8 (a-h,o-z)
4300 include 'DIMENSIONS'
4301 include 'sizesclu.dat'
4302 include 'COMMON.VAR'
4303 include 'COMMON.GEO'
4304 include 'COMMON.LOCAL'
4305 include 'COMMON.TORSION'
4306 include 'COMMON.INTERACT'
4307 include 'COMMON.DERIV'
4308 include 'COMMON.CHAIN'
4309 include 'COMMON.NAMES'
4310 include 'COMMON.IOUNITS'
4311 include 'COMMON.FFIELD'
4312 include 'COMMON.TORCNSTR'
4314 C Set lprn=.true. for debugging
4318 do i=iphi_start,iphi_end
4319 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4320 if (iabs(itype(i)).eq.20) then
4325 itori=itortyp(itype(i-2))
4326 itori1=itortyp(itype(i-1))
4329 C Regular cosine and sine terms
4330 do j=1,nterm(itori,itori1,iblock)
4331 v1ij=v1(j,itori,itori1,iblock)
4332 v2ij=v2(j,itori,itori1,iblock)
4335 etors=etors+v1ij*cosphi+v2ij*sinphi
4336 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4340 C E = SUM ----------------------------------- - v1
4341 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4343 cosphi=dcos(0.5d0*phii)
4344 sinphi=dsin(0.5d0*phii)
4345 do j=1,nlor(itori,itori1,iblock)
4346 vl1ij=vlor1(j,itori,itori1)
4347 vl2ij=vlor2(j,itori,itori1)
4348 vl3ij=vlor3(j,itori,itori1)
4349 pom=vl2ij*cosphi+vl3ij*sinphi
4350 pom1=1.0d0/(pom*pom+1.0d0)
4351 etors=etors+vl1ij*pom1
4353 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4355 C Subtract the constant term
4356 etors=etors-v0(itori,itori1,iblock)
4358 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4359 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4360 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4361 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4362 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4365 ! 6/20/98 - dihedral angle constraints
4367 c write (iout,*) "Dihedral angle restraint energy"
4369 itori=idih_constr(i)
4371 difi=pinorm(phii-phi0(i))
4372 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
4373 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
4374 if (difi.gt.drange(i)) then
4376 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4377 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4378 c write (iout,*) 0.25d0*ftors*difi**4
4379 else if (difi.lt.-drange(i)) then
4381 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4382 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4383 c write (iout,*) 0.25d0*ftors*difi**4
4386 c write (iout,*) 'edihcnstr',edihcnstr
4389 c----------------------------------------------------------------------------
4390 subroutine etor_d(etors_d,fact2)
4391 C 6/23/01 Compute double torsional energy
4392 implicit real*8 (a-h,o-z)
4393 include 'DIMENSIONS'
4394 include 'sizesclu.dat'
4395 include 'COMMON.VAR'
4396 include 'COMMON.GEO'
4397 include 'COMMON.LOCAL'
4398 include 'COMMON.TORSION'
4399 include 'COMMON.INTERACT'
4400 include 'COMMON.DERIV'
4401 include 'COMMON.CHAIN'
4402 include 'COMMON.NAMES'
4403 include 'COMMON.IOUNITS'
4404 include 'COMMON.FFIELD'
4405 include 'COMMON.TORCNSTR'
4407 C Set lprn=.true. for debugging
4411 do i=iphi_start,iphi_end-1
4412 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4414 itori=itortyp(itype(i-2))
4415 itori1=itortyp(itype(i-1))
4416 itori2=itortyp(itype(i))
4422 if (iabs(itype(i+1)).eq.20) iblock=2
4423 C Regular cosine and sine terms
4424 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4425 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4426 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4427 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4428 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4429 cosphi1=dcos(j*phii)
4430 sinphi1=dsin(j*phii)
4431 cosphi2=dcos(j*phii1)
4432 sinphi2=dsin(j*phii1)
4433 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4434 & v2cij*cosphi2+v2sij*sinphi2
4435 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4436 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4438 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4440 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4441 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4442 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4443 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4444 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4445 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4446 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4447 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4448 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4449 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4450 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4451 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4452 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4453 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4456 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4457 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4463 c------------------------------------------------------------------------------
4464 subroutine eback_sc_corr(esccor,fact)
4465 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4466 c conformational states; temporarily implemented as differences
4467 c between UNRES torsional potentials (dependent on three types of
4468 c residues) and the torsional potentials dependent on all 20 types
4469 c of residues computed from AM1 energy surfaces of terminally-blocked
4470 c amino-acid residues.
4471 implicit real*8 (a-h,o-z)
4472 include 'DIMENSIONS'
4473 include 'COMMON.VAR'
4474 include 'COMMON.GEO'
4475 include 'COMMON.LOCAL'
4476 include 'COMMON.TORSION'
4477 include 'COMMON.SCCOR'
4478 include 'COMMON.INTERACT'
4479 include 'COMMON.DERIV'
4480 include 'COMMON.CHAIN'
4481 include 'COMMON.NAMES'
4482 include 'COMMON.IOUNITS'
4483 include 'COMMON.FFIELD'
4484 include 'COMMON.CONTROL'
4486 C Set lprn=.true. for debugging
4489 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4491 do i=itau_start,itau_end
4493 isccori=isccortyp(itype(i-2))
4494 isccori1=isccortyp(itype(i-1))
4496 cccc Added 9 May 2012
4497 cc Tauangle is torsional engle depending on the value of first digit
4498 c(see comment below)
4499 cc Omicron is flat angle depending on the value of first digit
4500 c(see comment below)
4503 do intertyp=1,3 !intertyp
4504 cc Added 09 May 2012 (Adasko)
4505 cc Intertyp means interaction type of backbone mainchain correlation:
4506 c 1 = SC...Ca...Ca...Ca
4507 c 2 = Ca...Ca...Ca...SC
4508 c 3 = SC...Ca...Ca...SCi
4510 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4511 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4512 & (itype(i-1).eq.21)))
4513 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4514 & .or.(itype(i-2).eq.21)))
4515 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4516 & (itype(i-1).eq.21)))) cycle
4517 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4518 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4520 do j=1,nterm_sccor(isccori,isccori1)
4521 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4522 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4523 cosphi=dcos(j*tauangle(intertyp,i))
4524 sinphi=dsin(j*tauangle(intertyp,i))
4525 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4526 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4528 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4529 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4530 c &gloc_sc(intertyp,i-3,icg)
4532 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4533 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4534 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4535 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4536 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4542 c------------------------------------------------------------------------------
4543 subroutine multibody(ecorr)
4544 C This subroutine calculates multi-body contributions to energy following
4545 C the idea of Skolnick et al. If side chains I and J make a contact and
4546 C at the same time side chains I+1 and J+1 make a contact, an extra
4547 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4548 implicit real*8 (a-h,o-z)
4549 include 'DIMENSIONS'
4550 include 'COMMON.IOUNITS'
4551 include 'COMMON.DERIV'
4552 include 'COMMON.INTERACT'
4553 include 'COMMON.CONTACTS'
4554 double precision gx(3),gx1(3)
4557 C Set lprn=.true. for debugging
4561 write (iout,'(a)') 'Contact function values:'
4563 write (iout,'(i2,20(1x,i2,f10.5))')
4564 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4579 num_conti=num_cont(i)
4580 num_conti1=num_cont(i1)
4585 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4586 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4587 cd & ' ishift=',ishift
4588 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4589 C The system gains extra energy.
4590 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4591 endif ! j1==j+-ishift
4600 c------------------------------------------------------------------------------
4601 double precision function esccorr(i,j,k,l,jj,kk)
4602 implicit real*8 (a-h,o-z)
4603 include 'DIMENSIONS'
4604 include 'COMMON.IOUNITS'
4605 include 'COMMON.DERIV'
4606 include 'COMMON.INTERACT'
4607 include 'COMMON.CONTACTS'
4608 double precision gx(3),gx1(3)
4613 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4614 C Calculate the multi-body contribution to energy.
4615 C Calculate multi-body contributions to the gradient.
4616 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4617 cd & k,l,(gacont(m,kk,k),m=1,3)
4619 gx(m) =ekl*gacont(m,jj,i)
4620 gx1(m)=eij*gacont(m,kk,k)
4621 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4622 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4623 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4624 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4628 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4633 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4639 c------------------------------------------------------------------------------
4641 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4642 implicit real*8 (a-h,o-z)
4643 include 'DIMENSIONS'
4644 integer dimen1,dimen2,atom,indx
4645 double precision buffer(dimen1,dimen2)
4646 double precision zapas
4647 common /contacts_hb/ zapas(3,20,maxres,7),
4648 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4649 & num_cont_hb(maxres),jcont_hb(20,maxres)
4650 num_kont=num_cont_hb(atom)
4654 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4657 buffer(i,indx+22)=facont_hb(i,atom)
4658 buffer(i,indx+23)=ees0p(i,atom)
4659 buffer(i,indx+24)=ees0m(i,atom)
4660 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4662 buffer(1,indx+26)=dfloat(num_kont)
4665 c------------------------------------------------------------------------------
4666 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4667 implicit real*8 (a-h,o-z)
4668 include 'DIMENSIONS'
4669 integer dimen1,dimen2,atom,indx
4670 double precision buffer(dimen1,dimen2)
4671 double precision zapas
4672 common /contacts_hb/ zapas(3,20,maxres,7),
4673 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4674 & num_cont_hb(maxres),jcont_hb(20,maxres)
4675 num_kont=buffer(1,indx+26)
4676 num_kont_old=num_cont_hb(atom)
4677 num_cont_hb(atom)=num_kont+num_kont_old
4682 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4685 facont_hb(ii,atom)=buffer(i,indx+22)
4686 ees0p(ii,atom)=buffer(i,indx+23)
4687 ees0m(ii,atom)=buffer(i,indx+24)
4688 jcont_hb(ii,atom)=buffer(i,indx+25)
4692 c------------------------------------------------------------------------------
4694 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4695 C This subroutine calculates multi-body contributions to hydrogen-bonding
4696 implicit real*8 (a-h,o-z)
4697 include 'DIMENSIONS'
4698 include 'sizesclu.dat'
4699 include 'COMMON.IOUNITS'
4701 include 'COMMON.INFO'
4703 include 'COMMON.FFIELD'
4704 include 'COMMON.DERIV'
4705 include 'COMMON.INTERACT'
4706 include 'COMMON.CONTACTS'
4708 parameter (max_cont=maxconts)
4709 parameter (max_dim=2*(8*3+2))
4710 parameter (msglen1=max_cont*max_dim*4)
4711 parameter (msglen2=2*msglen1)
4712 integer source,CorrelType,CorrelID,Error
4713 double precision buffer(max_cont,max_dim)
4715 double precision gx(3),gx1(3)
4718 C Set lprn=.true. for debugging
4723 if (fgProcs.le.1) goto 30
4725 write (iout,'(a)') 'Contact function values:'
4727 write (iout,'(2i3,50(1x,i2,f5.2))')
4728 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4729 & j=1,num_cont_hb(i))
4732 C Caution! Following code assumes that electrostatic interactions concerning
4733 C a given atom are split among at most two processors!
4743 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4746 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4747 if (MyRank.gt.0) then
4748 C Send correlation contributions to the preceding processor
4750 nn=num_cont_hb(iatel_s)
4751 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4752 cd write (iout,*) 'The BUFFER array:'
4754 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4756 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4758 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4759 C Clear the contacts of the atom passed to the neighboring processor
4760 nn=num_cont_hb(iatel_s+1)
4762 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4764 num_cont_hb(iatel_s)=0
4766 cd write (iout,*) 'Processor ',MyID,MyRank,
4767 cd & ' is sending correlation contribution to processor',MyID-1,
4768 cd & ' msglen=',msglen
4769 cd write (*,*) 'Processor ',MyID,MyRank,
4770 cd & ' is sending correlation contribution to processor',MyID-1,
4771 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4772 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4773 cd write (iout,*) 'Processor ',MyID,
4774 cd & ' has sent correlation contribution to processor',MyID-1,
4775 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4776 cd write (*,*) 'Processor ',MyID,
4777 cd & ' has sent correlation contribution to processor',MyID-1,
4778 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4780 endif ! (MyRank.gt.0)
4784 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4785 if (MyRank.lt.fgProcs-1) then
4786 C Receive correlation contributions from the next processor
4788 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4789 cd write (iout,*) 'Processor',MyID,
4790 cd & ' is receiving correlation contribution from processor',MyID+1,
4791 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4792 cd write (*,*) 'Processor',MyID,
4793 cd & ' is receiving correlation contribution from processor',MyID+1,
4794 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4796 do while (nbytes.le.0)
4797 call mp_probe(MyID+1,CorrelType,nbytes)
4799 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4800 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4801 cd write (iout,*) 'Processor',MyID,
4802 cd & ' has received correlation contribution from processor',MyID+1,
4803 cd & ' msglen=',msglen,' nbytes=',nbytes
4804 cd write (iout,*) 'The received BUFFER array:'
4806 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4808 if (msglen.eq.msglen1) then
4809 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4810 else if (msglen.eq.msglen2) then
4811 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4812 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4815 & 'ERROR!!!! message length changed while processing correlations.'
4817 & 'ERROR!!!! message length changed while processing correlations.'
4818 call mp_stopall(Error)
4819 endif ! msglen.eq.msglen1
4820 endif ! MyRank.lt.fgProcs-1
4827 write (iout,'(a)') 'Contact function values:'
4829 write (iout,'(2i3,50(1x,i2,f5.2))')
4830 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4831 & j=1,num_cont_hb(i))
4835 C Remove the loop below after debugging !!!
4842 C Calculate the local-electrostatic correlation terms
4843 do i=iatel_s,iatel_e+1
4845 num_conti=num_cont_hb(i)
4846 num_conti1=num_cont_hb(i+1)
4851 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4852 c & ' jj=',jj,' kk=',kk
4853 if (j1.eq.j+1 .or. j1.eq.j-1) then
4854 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4855 C The system gains extra energy.
4856 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4858 else if (j1.eq.j) then
4859 C Contacts I-J and I-(J+1) occur simultaneously.
4860 C The system loses extra energy.
4861 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4866 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4867 c & ' jj=',jj,' kk=',kk
4869 C Contacts I-J and (I+1)-J occur simultaneously.
4870 C The system loses extra energy.
4871 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4878 c------------------------------------------------------------------------------
4879 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4881 C This subroutine calculates multi-body contributions to hydrogen-bonding
4882 implicit real*8 (a-h,o-z)
4883 include 'DIMENSIONS'
4884 include 'sizesclu.dat'
4885 include 'COMMON.IOUNITS'
4887 include 'COMMON.INFO'
4889 include 'COMMON.FFIELD'
4890 include 'COMMON.DERIV'
4891 include 'COMMON.INTERACT'
4892 include 'COMMON.CONTACTS'
4894 parameter (max_cont=maxconts)
4895 parameter (max_dim=2*(8*3+2))
4896 parameter (msglen1=max_cont*max_dim*4)
4897 parameter (msglen2=2*msglen1)
4898 integer source,CorrelType,CorrelID,Error
4899 double precision buffer(max_cont,max_dim)
4901 double precision gx(3),gx1(3)
4904 C Set lprn=.true. for debugging
4910 if (fgProcs.le.1) goto 30
4912 write (iout,'(a)') 'Contact function values:'
4914 write (iout,'(2i3,50(1x,i2,f5.2))')
4915 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4916 & j=1,num_cont_hb(i))
4919 C Caution! Following code assumes that electrostatic interactions concerning
4920 C a given atom are split among at most two processors!
4930 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4933 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4934 if (MyRank.gt.0) then
4935 C Send correlation contributions to the preceding processor
4937 nn=num_cont_hb(iatel_s)
4938 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4939 cd write (iout,*) 'The BUFFER array:'
4941 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4943 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4945 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4946 C Clear the contacts of the atom passed to the neighboring processor
4947 nn=num_cont_hb(iatel_s+1)
4949 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4951 num_cont_hb(iatel_s)=0
4953 cd write (iout,*) 'Processor ',MyID,MyRank,
4954 cd & ' is sending correlation contribution to processor',MyID-1,
4955 cd & ' msglen=',msglen
4956 cd write (*,*) 'Processor ',MyID,MyRank,
4957 cd & ' is sending correlation contribution to processor',MyID-1,
4958 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4959 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4960 cd write (iout,*) 'Processor ',MyID,
4961 cd & ' has sent correlation contribution to processor',MyID-1,
4962 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4963 cd write (*,*) 'Processor ',MyID,
4964 cd & ' has sent correlation contribution to processor',MyID-1,
4965 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4967 endif ! (MyRank.gt.0)
4971 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4972 if (MyRank.lt.fgProcs-1) then
4973 C Receive correlation contributions from the next processor
4975 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4976 cd write (iout,*) 'Processor',MyID,
4977 cd & ' is receiving correlation contribution from processor',MyID+1,
4978 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4979 cd write (*,*) 'Processor',MyID,
4980 cd & ' is receiving correlation contribution from processor',MyID+1,
4981 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4983 do while (nbytes.le.0)
4984 call mp_probe(MyID+1,CorrelType,nbytes)
4986 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4987 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4988 cd write (iout,*) 'Processor',MyID,
4989 cd & ' has received correlation contribution from processor',MyID+1,
4990 cd & ' msglen=',msglen,' nbytes=',nbytes
4991 cd write (iout,*) 'The received BUFFER array:'
4993 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4995 if (msglen.eq.msglen1) then
4996 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4997 else if (msglen.eq.msglen2) then
4998 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4999 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5002 & 'ERROR!!!! message length changed while processing correlations.'
5004 & 'ERROR!!!! message length changed while processing correlations.'
5005 call mp_stopall(Error)
5006 endif ! msglen.eq.msglen1
5007 endif ! MyRank.lt.fgProcs-1
5014 write (iout,'(a)') 'Contact function values:'
5016 write (iout,'(2i3,50(1x,i2,f5.2))')
5017 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5018 & j=1,num_cont_hb(i))
5024 C Remove the loop below after debugging !!!
5031 C Calculate the dipole-dipole interaction energies
5032 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5033 do i=iatel_s,iatel_e+1
5034 num_conti=num_cont_hb(i)
5041 C Calculate the local-electrostatic correlation terms
5042 do i=iatel_s,iatel_e+1
5044 num_conti=num_cont_hb(i)
5045 num_conti1=num_cont_hb(i+1)
5050 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5051 c & ' jj=',jj,' kk=',kk
5052 if (j1.eq.j+1 .or. j1.eq.j-1) then
5053 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5054 C The system gains extra energy.
5056 sqd1=dsqrt(d_cont(jj,i))
5057 sqd2=dsqrt(d_cont(kk,i1))
5058 sred_geom = sqd1*sqd2
5059 IF (sred_geom.lt.cutoff_corr) THEN
5060 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5062 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5063 c & ' jj=',jj,' kk=',kk
5064 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5065 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5067 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5068 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5071 cd write (iout,*) 'sred_geom=',sred_geom,
5072 cd & ' ekont=',ekont,' fprim=',fprimcont
5073 call calc_eello(i,j,i+1,j1,jj,kk)
5074 if (wcorr4.gt.0.0d0)
5075 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5076 if (wcorr5.gt.0.0d0)
5077 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5078 c print *,"wcorr5",ecorr5
5079 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5080 cd write(2,*)'ijkl',i,j,i+1,j1
5081 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5082 & .or. wturn6.eq.0.0d0))then
5083 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5084 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5085 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5086 cd & 'ecorr6=',ecorr6
5087 cd write (iout,'(4e15.5)') sred_geom,
5088 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5089 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5090 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5091 else if (wturn6.gt.0.0d0
5092 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5093 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5094 eturn6=eturn6+eello_turn6(i,jj,kk)
5095 cd write (2,*) 'multibody_eello:eturn6',eturn6
5099 else if (j1.eq.j) then
5100 C Contacts I-J and I-(J+1) occur simultaneously.
5101 C The system loses extra energy.
5102 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5107 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5108 c & ' jj=',jj,' kk=',kk
5110 C Contacts I-J and (I+1)-J occur simultaneously.
5111 C The system loses extra energy.
5112 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5119 c------------------------------------------------------------------------------
5120 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5121 implicit real*8 (a-h,o-z)
5122 include 'DIMENSIONS'
5123 include 'COMMON.IOUNITS'
5124 include 'COMMON.DERIV'
5125 include 'COMMON.INTERACT'
5126 include 'COMMON.CONTACTS'
5127 double precision gx(3),gx1(3)
5137 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5138 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5139 C Following 4 lines for diagnostics.
5144 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5146 c write (iout,*)'Contacts have occurred for peptide groups',
5147 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5148 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5149 C Calculate the multi-body contribution to energy.
5150 ecorr=ecorr+ekont*ees
5152 C Calculate multi-body contributions to the gradient.
5154 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5155 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5156 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5157 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5158 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5159 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5160 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5161 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5162 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5163 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5164 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5165 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5166 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5167 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5171 gradcorr(ll,m)=gradcorr(ll,m)+
5172 & ees*ekl*gacont_hbr(ll,jj,i)-
5173 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5174 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5179 gradcorr(ll,m)=gradcorr(ll,m)+
5180 & ees*eij*gacont_hbr(ll,kk,k)-
5181 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5182 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5189 C---------------------------------------------------------------------------
5190 subroutine dipole(i,j,jj)
5191 implicit real*8 (a-h,o-z)
5192 include 'DIMENSIONS'
5193 include 'sizesclu.dat'
5194 include 'COMMON.IOUNITS'
5195 include 'COMMON.CHAIN'
5196 include 'COMMON.FFIELD'
5197 include 'COMMON.DERIV'
5198 include 'COMMON.INTERACT'
5199 include 'COMMON.CONTACTS'
5200 include 'COMMON.TORSION'
5201 include 'COMMON.VAR'
5202 include 'COMMON.GEO'
5203 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5205 iti1 = itortyp(itype(i+1))
5206 if (j.lt.nres-1) then
5207 itj1 = itortyp(itype(j+1))
5212 dipi(iii,1)=Ub2(iii,i)
5213 dipderi(iii)=Ub2der(iii,i)
5214 dipi(iii,2)=b1(iii,iti1)
5215 dipj(iii,1)=Ub2(iii,j)
5216 dipderj(iii)=Ub2der(iii,j)
5217 dipj(iii,2)=b1(iii,itj1)
5221 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5224 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5227 if (.not.calc_grad) return
5232 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5236 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5241 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5242 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5244 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5246 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5248 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5252 C---------------------------------------------------------------------------
5253 subroutine calc_eello(i,j,k,l,jj,kk)
5255 C This subroutine computes matrices and vectors needed to calculate
5256 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5258 implicit real*8 (a-h,o-z)
5259 include 'DIMENSIONS'
5260 include 'sizesclu.dat'
5261 include 'COMMON.IOUNITS'
5262 include 'COMMON.CHAIN'
5263 include 'COMMON.DERIV'
5264 include 'COMMON.INTERACT'
5265 include 'COMMON.CONTACTS'
5266 include 'COMMON.TORSION'
5267 include 'COMMON.VAR'
5268 include 'COMMON.GEO'
5269 include 'COMMON.FFIELD'
5270 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5271 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5274 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5275 cd & ' jj=',jj,' kk=',kk
5276 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5279 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5280 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5283 call transpose2(aa1(1,1),aa1t(1,1))
5284 call transpose2(aa2(1,1),aa2t(1,1))
5287 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5288 & aa1tder(1,1,lll,kkk))
5289 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5290 & aa2tder(1,1,lll,kkk))
5294 C parallel orientation of the two CA-CA-CA frames.
5296 iti=itortyp(itype(i))
5300 itk1=itortyp(itype(k+1))
5301 itj=itortyp(itype(j))
5302 if (l.lt.nres-1) then
5303 itl1=itortyp(itype(l+1))
5307 C A1 kernel(j+1) A2T
5309 cd write (iout,'(3f10.5,5x,3f10.5)')
5310 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5312 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5313 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5314 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5315 C Following matrices are needed only for 6-th order cumulants
5316 IF (wcorr6.gt.0.0d0) THEN
5317 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5318 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5319 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5320 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5321 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5322 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5323 & ADtEAderx(1,1,1,1,1,1))
5325 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5326 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5327 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5328 & ADtEA1derx(1,1,1,1,1,1))
5330 C End 6-th order cumulants
5333 cd write (2,*) 'In calc_eello6'
5335 cd write (2,*) 'iii=',iii
5337 cd write (2,*) 'kkk=',kkk
5339 cd write (2,'(3(2f10.5),5x)')
5340 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5345 call transpose2(EUgder(1,1,k),auxmat(1,1))
5346 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5347 call transpose2(EUg(1,1,k),auxmat(1,1))
5348 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5349 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5353 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5354 & EAEAderx(1,1,lll,kkk,iii,1))
5358 C A1T kernel(i+1) A2
5359 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5360 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5361 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5362 C Following matrices are needed only for 6-th order cumulants
5363 IF (wcorr6.gt.0.0d0) THEN
5364 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5365 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5366 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5367 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5368 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5369 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5370 & ADtEAderx(1,1,1,1,1,2))
5371 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5372 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5373 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5374 & ADtEA1derx(1,1,1,1,1,2))
5376 C End 6-th order cumulants
5377 call transpose2(EUgder(1,1,l),auxmat(1,1))
5378 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5379 call transpose2(EUg(1,1,l),auxmat(1,1))
5380 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5381 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5385 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5386 & EAEAderx(1,1,lll,kkk,iii,2))
5391 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5392 C They are needed only when the fifth- or the sixth-order cumulants are
5394 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5395 call transpose2(AEA(1,1,1),auxmat(1,1))
5396 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5397 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5398 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5399 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5400 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5401 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5402 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5403 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5404 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5405 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5406 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5407 call transpose2(AEA(1,1,2),auxmat(1,1))
5408 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5409 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5410 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5411 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5412 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5413 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5414 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5415 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5416 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5417 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5418 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5419 C Calculate the Cartesian derivatives of the vectors.
5423 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5424 call matvec2(auxmat(1,1),b1(1,iti),
5425 & AEAb1derx(1,lll,kkk,iii,1,1))
5426 call matvec2(auxmat(1,1),Ub2(1,i),
5427 & AEAb2derx(1,lll,kkk,iii,1,1))
5428 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5429 & AEAb1derx(1,lll,kkk,iii,2,1))
5430 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5431 & AEAb2derx(1,lll,kkk,iii,2,1))
5432 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5433 call matvec2(auxmat(1,1),b1(1,itj),
5434 & AEAb1derx(1,lll,kkk,iii,1,2))
5435 call matvec2(auxmat(1,1),Ub2(1,j),
5436 & AEAb2derx(1,lll,kkk,iii,1,2))
5437 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5438 & AEAb1derx(1,lll,kkk,iii,2,2))
5439 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5440 & AEAb2derx(1,lll,kkk,iii,2,2))
5447 C Antiparallel orientation of the two CA-CA-CA frames.
5449 iti=itortyp(itype(i))
5453 itk1=itortyp(itype(k+1))
5454 itl=itortyp(itype(l))
5455 itj=itortyp(itype(j))
5456 if (j.lt.nres-1) then
5457 itj1=itortyp(itype(j+1))
5461 C A2 kernel(j-1)T A1T
5462 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5463 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5464 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5465 C Following matrices are needed only for 6-th order cumulants
5466 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5467 & j.eq.i+4 .and. l.eq.i+3)) THEN
5468 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5469 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5470 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5471 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5472 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5473 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5474 & ADtEAderx(1,1,1,1,1,1))
5475 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5476 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5477 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5478 & ADtEA1derx(1,1,1,1,1,1))
5480 C End 6-th order cumulants
5481 call transpose2(EUgder(1,1,k),auxmat(1,1))
5482 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5483 call transpose2(EUg(1,1,k),auxmat(1,1))
5484 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5485 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5489 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5490 & EAEAderx(1,1,lll,kkk,iii,1))
5494 C A2T kernel(i+1)T A1
5495 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5496 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5497 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5498 C Following matrices are needed only for 6-th order cumulants
5499 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5500 & j.eq.i+4 .and. l.eq.i+3)) THEN
5501 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5502 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5503 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5504 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5505 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5506 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5507 & ADtEAderx(1,1,1,1,1,2))
5508 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5509 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5510 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5511 & ADtEA1derx(1,1,1,1,1,2))
5513 C End 6-th order cumulants
5514 call transpose2(EUgder(1,1,j),auxmat(1,1))
5515 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5516 call transpose2(EUg(1,1,j),auxmat(1,1))
5517 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5518 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5522 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5523 & EAEAderx(1,1,lll,kkk,iii,2))
5528 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5529 C They are needed only when the fifth- or the sixth-order cumulants are
5531 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5532 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5533 call transpose2(AEA(1,1,1),auxmat(1,1))
5534 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5535 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5536 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5537 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5538 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5539 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5540 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5541 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5542 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5543 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5544 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5545 call transpose2(AEA(1,1,2),auxmat(1,1))
5546 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5547 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5548 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5549 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5550 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5551 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5552 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5553 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5554 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5555 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5556 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5557 C Calculate the Cartesian derivatives of the vectors.
5561 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5562 call matvec2(auxmat(1,1),b1(1,iti),
5563 & AEAb1derx(1,lll,kkk,iii,1,1))
5564 call matvec2(auxmat(1,1),Ub2(1,i),
5565 & AEAb2derx(1,lll,kkk,iii,1,1))
5566 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5567 & AEAb1derx(1,lll,kkk,iii,2,1))
5568 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5569 & AEAb2derx(1,lll,kkk,iii,2,1))
5570 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5571 call matvec2(auxmat(1,1),b1(1,itl),
5572 & AEAb1derx(1,lll,kkk,iii,1,2))
5573 call matvec2(auxmat(1,1),Ub2(1,l),
5574 & AEAb2derx(1,lll,kkk,iii,1,2))
5575 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5576 & AEAb1derx(1,lll,kkk,iii,2,2))
5577 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5578 & AEAb2derx(1,lll,kkk,iii,2,2))
5587 C---------------------------------------------------------------------------
5588 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5589 & KK,KKderg,AKA,AKAderg,AKAderx)
5593 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5594 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5595 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5600 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5602 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5605 cd if (lprn) write (2,*) 'In kernel'
5607 cd if (lprn) write (2,*) 'kkk=',kkk
5609 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5610 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5612 cd write (2,*) 'lll=',lll
5613 cd write (2,*) 'iii=1'
5615 cd write (2,'(3(2f10.5),5x)')
5616 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5619 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5620 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5622 cd write (2,*) 'lll=',lll
5623 cd write (2,*) 'iii=2'
5625 cd write (2,'(3(2f10.5),5x)')
5626 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5633 C---------------------------------------------------------------------------
5634 double precision function eello4(i,j,k,l,jj,kk)
5635 implicit real*8 (a-h,o-z)
5636 include 'DIMENSIONS'
5637 include 'sizesclu.dat'
5638 include 'COMMON.IOUNITS'
5639 include 'COMMON.CHAIN'
5640 include 'COMMON.DERIV'
5641 include 'COMMON.INTERACT'
5642 include 'COMMON.CONTACTS'
5643 include 'COMMON.TORSION'
5644 include 'COMMON.VAR'
5645 include 'COMMON.GEO'
5646 double precision pizda(2,2),ggg1(3),ggg2(3)
5647 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5651 cd print *,'eello4:',i,j,k,l,jj,kk
5652 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5653 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5654 cold eij=facont_hb(jj,i)
5655 cold ekl=facont_hb(kk,k)
5657 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5659 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5660 gcorr_loc(k-1)=gcorr_loc(k-1)
5661 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5663 gcorr_loc(l-1)=gcorr_loc(l-1)
5664 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5666 gcorr_loc(j-1)=gcorr_loc(j-1)
5667 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5672 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5673 & -EAEAderx(2,2,lll,kkk,iii,1)
5674 cd derx(lll,kkk,iii)=0.0d0
5678 cd gcorr_loc(l-1)=0.0d0
5679 cd gcorr_loc(j-1)=0.0d0
5680 cd gcorr_loc(k-1)=0.0d0
5682 cd write (iout,*)'Contacts have occurred for peptide groups',
5683 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5684 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5685 if (j.lt.nres-1) then
5692 if (l.lt.nres-1) then
5700 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5701 ggg1(ll)=eel4*g_contij(ll,1)
5702 ggg2(ll)=eel4*g_contij(ll,2)
5703 ghalf=0.5d0*ggg1(ll)
5705 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5706 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5707 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5708 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5709 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5710 ghalf=0.5d0*ggg2(ll)
5712 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5713 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5714 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5715 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5720 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5721 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5726 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5727 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5733 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5738 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5742 cd write (2,*) iii,gcorr_loc(iii)
5746 cd write (2,*) 'ekont',ekont
5747 cd write (iout,*) 'eello4',ekont*eel4
5750 C---------------------------------------------------------------------------
5751 double precision function eello5(i,j,k,l,jj,kk)
5752 implicit real*8 (a-h,o-z)
5753 include 'DIMENSIONS'
5754 include 'sizesclu.dat'
5755 include 'COMMON.IOUNITS'
5756 include 'COMMON.CHAIN'
5757 include 'COMMON.DERIV'
5758 include 'COMMON.INTERACT'
5759 include 'COMMON.CONTACTS'
5760 include 'COMMON.TORSION'
5761 include 'COMMON.VAR'
5762 include 'COMMON.GEO'
5763 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5764 double precision ggg1(3),ggg2(3)
5765 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5770 C /l\ / \ \ / \ / \ / C
5771 C / \ / \ \ / \ / \ / C
5772 C j| o |l1 | o | o| o | | o |o C
5773 C \ |/k\| |/ \| / |/ \| |/ \| C
5774 C \i/ \ / \ / / \ / \ C
5776 C (I) (II) (III) (IV) C
5778 C eello5_1 eello5_2 eello5_3 eello5_4 C
5780 C Antiparallel chains C
5783 C /j\ / \ \ / \ / \ / C
5784 C / \ / \ \ / \ / \ / C
5785 C j1| o |l | o | o| o | | o |o C
5786 C \ |/k\| |/ \| / |/ \| |/ \| C
5787 C \i/ \ / \ / / \ / \ C
5789 C (I) (II) (III) (IV) C
5791 C eello5_1 eello5_2 eello5_3 eello5_4 C
5793 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5795 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5796 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5801 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5803 itk=itortyp(itype(k))
5804 itl=itortyp(itype(l))
5805 itj=itortyp(itype(j))
5810 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5811 cd & eel5_3_num,eel5_4_num)
5815 derx(lll,kkk,iii)=0.0d0
5819 cd eij=facont_hb(jj,i)
5820 cd ekl=facont_hb(kk,k)
5822 cd write (iout,*)'Contacts have occurred for peptide groups',
5823 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5825 C Contribution from the graph I.
5826 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5827 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5828 call transpose2(EUg(1,1,k),auxmat(1,1))
5829 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5830 vv(1)=pizda(1,1)-pizda(2,2)
5831 vv(2)=pizda(1,2)+pizda(2,1)
5832 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5833 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5835 C Explicit gradient in virtual-dihedral angles.
5836 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5837 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5838 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5839 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5840 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5841 vv(1)=pizda(1,1)-pizda(2,2)
5842 vv(2)=pizda(1,2)+pizda(2,1)
5843 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5844 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5845 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5846 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5847 vv(1)=pizda(1,1)-pizda(2,2)
5848 vv(2)=pizda(1,2)+pizda(2,1)
5850 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5851 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5852 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5854 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5855 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5856 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5858 C Cartesian gradient
5862 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5864 vv(1)=pizda(1,1)-pizda(2,2)
5865 vv(2)=pizda(1,2)+pizda(2,1)
5866 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5867 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5868 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5875 C Contribution from graph II
5876 call transpose2(EE(1,1,itk),auxmat(1,1))
5877 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5878 vv(1)=pizda(1,1)+pizda(2,2)
5879 vv(2)=pizda(2,1)-pizda(1,2)
5880 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5881 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5883 C Explicit gradient in virtual-dihedral angles.
5884 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5885 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5886 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5887 vv(1)=pizda(1,1)+pizda(2,2)
5888 vv(2)=pizda(2,1)-pizda(1,2)
5890 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5891 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5892 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5894 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5895 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5896 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5898 C Cartesian gradient
5902 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5904 vv(1)=pizda(1,1)+pizda(2,2)
5905 vv(2)=pizda(2,1)-pizda(1,2)
5906 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5907 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5908 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5917 C Parallel orientation
5918 C Contribution from graph III
5919 call transpose2(EUg(1,1,l),auxmat(1,1))
5920 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5921 vv(1)=pizda(1,1)-pizda(2,2)
5922 vv(2)=pizda(1,2)+pizda(2,1)
5923 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5924 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5926 C Explicit gradient in virtual-dihedral angles.
5927 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5928 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5929 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5930 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5931 vv(1)=pizda(1,1)-pizda(2,2)
5932 vv(2)=pizda(1,2)+pizda(2,1)
5933 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5934 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5935 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5936 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5937 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5938 vv(1)=pizda(1,1)-pizda(2,2)
5939 vv(2)=pizda(1,2)+pizda(2,1)
5940 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5941 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5942 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5943 C Cartesian gradient
5947 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5949 vv(1)=pizda(1,1)-pizda(2,2)
5950 vv(2)=pizda(1,2)+pizda(2,1)
5951 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5952 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5953 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5959 C Contribution from graph IV
5961 call transpose2(EE(1,1,itl),auxmat(1,1))
5962 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5963 vv(1)=pizda(1,1)+pizda(2,2)
5964 vv(2)=pizda(2,1)-pizda(1,2)
5965 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5966 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5968 C Explicit gradient in virtual-dihedral angles.
5969 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5970 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5971 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5972 vv(1)=pizda(1,1)+pizda(2,2)
5973 vv(2)=pizda(2,1)-pizda(1,2)
5974 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5975 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5976 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5977 C Cartesian gradient
5981 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5983 vv(1)=pizda(1,1)+pizda(2,2)
5984 vv(2)=pizda(2,1)-pizda(1,2)
5985 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5986 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5987 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5993 C Antiparallel orientation
5994 C Contribution from graph III
5996 call transpose2(EUg(1,1,j),auxmat(1,1))
5997 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5998 vv(1)=pizda(1,1)-pizda(2,2)
5999 vv(2)=pizda(1,2)+pizda(2,1)
6000 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6001 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6003 C Explicit gradient in virtual-dihedral angles.
6004 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6005 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6006 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6007 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6008 vv(1)=pizda(1,1)-pizda(2,2)
6009 vv(2)=pizda(1,2)+pizda(2,1)
6010 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6011 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6012 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6013 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6014 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6015 vv(1)=pizda(1,1)-pizda(2,2)
6016 vv(2)=pizda(1,2)+pizda(2,1)
6017 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6018 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6019 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6020 C Cartesian gradient
6024 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6026 vv(1)=pizda(1,1)-pizda(2,2)
6027 vv(2)=pizda(1,2)+pizda(2,1)
6028 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6029 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6030 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6036 C Contribution from graph IV
6038 call transpose2(EE(1,1,itj),auxmat(1,1))
6039 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6040 vv(1)=pizda(1,1)+pizda(2,2)
6041 vv(2)=pizda(2,1)-pizda(1,2)
6042 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6043 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6045 C Explicit gradient in virtual-dihedral angles.
6046 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6047 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6048 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6049 vv(1)=pizda(1,1)+pizda(2,2)
6050 vv(2)=pizda(2,1)-pizda(1,2)
6051 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6052 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6053 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6054 C Cartesian gradient
6058 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6060 vv(1)=pizda(1,1)+pizda(2,2)
6061 vv(2)=pizda(2,1)-pizda(1,2)
6062 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6063 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6064 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6071 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6072 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6073 cd write (2,*) 'ijkl',i,j,k,l
6074 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6075 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6077 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6078 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6079 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6080 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6082 if (j.lt.nres-1) then
6089 if (l.lt.nres-1) then
6099 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6101 ggg1(ll)=eel5*g_contij(ll,1)
6102 ggg2(ll)=eel5*g_contij(ll,2)
6103 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6104 ghalf=0.5d0*ggg1(ll)
6106 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6107 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6108 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6109 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6110 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6111 ghalf=0.5d0*ggg2(ll)
6113 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6114 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6115 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6116 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6121 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6122 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6127 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6128 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6134 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6139 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6143 cd write (2,*) iii,g_corr5_loc(iii)
6147 cd write (2,*) 'ekont',ekont
6148 cd write (iout,*) 'eello5',ekont*eel5
6151 c--------------------------------------------------------------------------
6152 double precision function eello6(i,j,k,l,jj,kk)
6153 implicit real*8 (a-h,o-z)
6154 include 'DIMENSIONS'
6155 include 'sizesclu.dat'
6156 include 'COMMON.IOUNITS'
6157 include 'COMMON.CHAIN'
6158 include 'COMMON.DERIV'
6159 include 'COMMON.INTERACT'
6160 include 'COMMON.CONTACTS'
6161 include 'COMMON.TORSION'
6162 include 'COMMON.VAR'
6163 include 'COMMON.GEO'
6164 include 'COMMON.FFIELD'
6165 double precision ggg1(3),ggg2(3)
6166 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6171 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6179 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6180 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6184 derx(lll,kkk,iii)=0.0d0
6188 cd eij=facont_hb(jj,i)
6189 cd ekl=facont_hb(kk,k)
6195 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6196 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6197 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6198 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6199 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6200 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6202 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6203 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6204 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6205 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6206 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6207 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6211 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6213 C If turn contributions are considered, they will be handled separately.
6214 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6215 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6216 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6217 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6218 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6219 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6220 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6223 if (j.lt.nres-1) then
6230 if (l.lt.nres-1) then
6238 ggg1(ll)=eel6*g_contij(ll,1)
6239 ggg2(ll)=eel6*g_contij(ll,2)
6240 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6241 ghalf=0.5d0*ggg1(ll)
6243 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6244 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6245 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6246 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6247 ghalf=0.5d0*ggg2(ll)
6248 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6250 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6251 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6252 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6253 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6258 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6259 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6264 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6265 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6271 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6276 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6280 cd write (2,*) iii,g_corr6_loc(iii)
6284 cd write (2,*) 'ekont',ekont
6285 cd write (iout,*) 'eello6',ekont*eel6
6288 c--------------------------------------------------------------------------
6289 double precision function eello6_graph1(i,j,k,l,imat,swap)
6290 implicit real*8 (a-h,o-z)
6291 include 'DIMENSIONS'
6292 include 'sizesclu.dat'
6293 include 'COMMON.IOUNITS'
6294 include 'COMMON.CHAIN'
6295 include 'COMMON.DERIV'
6296 include 'COMMON.INTERACT'
6297 include 'COMMON.CONTACTS'
6298 include 'COMMON.TORSION'
6299 include 'COMMON.VAR'
6300 include 'COMMON.GEO'
6301 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6305 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6307 C Parallel Antiparallel C
6313 C \ j|/k\| / \ |/k\|l / C
6318 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6319 itk=itortyp(itype(k))
6320 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6321 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6322 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6323 call transpose2(EUgC(1,1,k),auxmat(1,1))
6324 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6325 vv1(1)=pizda1(1,1)-pizda1(2,2)
6326 vv1(2)=pizda1(1,2)+pizda1(2,1)
6327 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6328 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6329 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6330 s5=scalar2(vv(1),Dtobr2(1,i))
6331 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6332 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6333 if (.not. calc_grad) return
6334 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6335 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6336 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6337 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6338 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6339 & +scalar2(vv(1),Dtobr2der(1,i)))
6340 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6341 vv1(1)=pizda1(1,1)-pizda1(2,2)
6342 vv1(2)=pizda1(1,2)+pizda1(2,1)
6343 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6344 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6346 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6347 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6348 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6349 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6350 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6352 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6353 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6354 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6355 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6356 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6358 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6359 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6360 vv1(1)=pizda1(1,1)-pizda1(2,2)
6361 vv1(2)=pizda1(1,2)+pizda1(2,1)
6362 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6363 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6364 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6365 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6374 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6375 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6376 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6377 call transpose2(EUgC(1,1,k),auxmat(1,1))
6378 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6380 vv1(1)=pizda1(1,1)-pizda1(2,2)
6381 vv1(2)=pizda1(1,2)+pizda1(2,1)
6382 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6383 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6384 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6385 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6386 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6387 s5=scalar2(vv(1),Dtobr2(1,i))
6388 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6394 c----------------------------------------------------------------------------
6395 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6396 implicit real*8 (a-h,o-z)
6397 include 'DIMENSIONS'
6398 include 'sizesclu.dat'
6399 include 'COMMON.IOUNITS'
6400 include 'COMMON.CHAIN'
6401 include 'COMMON.DERIV'
6402 include 'COMMON.INTERACT'
6403 include 'COMMON.CONTACTS'
6404 include 'COMMON.TORSION'
6405 include 'COMMON.VAR'
6406 include 'COMMON.GEO'
6408 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6409 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6412 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6414 C Parallel Antiparallel C
6420 C \ j|/k\| \ |/k\|l C
6425 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6426 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6427 C AL 7/4/01 s1 would occur in the sixth-order moment,
6428 C but not in a cluster cumulant
6430 s1=dip(1,jj,i)*dip(1,kk,k)
6432 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6433 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6434 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6435 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6436 call transpose2(EUg(1,1,k),auxmat(1,1))
6437 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6438 vv(1)=pizda(1,1)-pizda(2,2)
6439 vv(2)=pizda(1,2)+pizda(2,1)
6440 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6441 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6443 eello6_graph2=-(s1+s2+s3+s4)
6445 eello6_graph2=-(s2+s3+s4)
6448 if (.not. calc_grad) return
6449 C Derivatives in gamma(i-1)
6452 s1=dipderg(1,jj,i)*dip(1,kk,k)
6454 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6455 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6456 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6457 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6459 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6461 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6463 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6465 C Derivatives in gamma(k-1)
6467 s1=dip(1,jj,i)*dipderg(1,kk,k)
6469 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6470 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6471 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6472 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6473 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6474 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6475 vv(1)=pizda(1,1)-pizda(2,2)
6476 vv(2)=pizda(1,2)+pizda(2,1)
6477 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6479 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6481 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6483 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6484 C Derivatives in gamma(j-1) or gamma(l-1)
6487 s1=dipderg(3,jj,i)*dip(1,kk,k)
6489 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6490 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6491 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6492 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6493 vv(1)=pizda(1,1)-pizda(2,2)
6494 vv(2)=pizda(1,2)+pizda(2,1)
6495 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6498 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6500 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6503 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6504 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6506 C Derivatives in gamma(l-1) or gamma(j-1)
6509 s1=dip(1,jj,i)*dipderg(3,kk,k)
6511 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6512 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6513 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6514 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6515 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6516 vv(1)=pizda(1,1)-pizda(2,2)
6517 vv(2)=pizda(1,2)+pizda(2,1)
6518 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6521 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6523 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6526 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6527 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6529 C Cartesian derivatives.
6531 write (2,*) 'In eello6_graph2'
6533 write (2,*) 'iii=',iii
6535 write (2,*) 'kkk=',kkk
6537 write (2,'(3(2f10.5),5x)')
6538 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6548 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6550 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6553 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6555 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6556 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6558 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6559 call transpose2(EUg(1,1,k),auxmat(1,1))
6560 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6562 vv(1)=pizda(1,1)-pizda(2,2)
6563 vv(2)=pizda(1,2)+pizda(2,1)
6564 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6565 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6567 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6569 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6572 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6574 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6581 c----------------------------------------------------------------------------
6582 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6583 implicit real*8 (a-h,o-z)
6584 include 'DIMENSIONS'
6585 include 'sizesclu.dat'
6586 include 'COMMON.IOUNITS'
6587 include 'COMMON.CHAIN'
6588 include 'COMMON.DERIV'
6589 include 'COMMON.INTERACT'
6590 include 'COMMON.CONTACTS'
6591 include 'COMMON.TORSION'
6592 include 'COMMON.VAR'
6593 include 'COMMON.GEO'
6594 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6596 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6598 C Parallel Antiparallel C
6604 C j|/k\| / |/k\|l / C
6609 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6611 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6612 C energy moment and not to the cluster cumulant.
6613 iti=itortyp(itype(i))
6614 if (j.lt.nres-1) then
6615 itj1=itortyp(itype(j+1))
6619 itk=itortyp(itype(k))
6620 itk1=itortyp(itype(k+1))
6621 if (l.lt.nres-1) then
6622 itl1=itortyp(itype(l+1))
6627 s1=dip(4,jj,i)*dip(4,kk,k)
6629 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6630 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6631 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6632 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6633 call transpose2(EE(1,1,itk),auxmat(1,1))
6634 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6635 vv(1)=pizda(1,1)+pizda(2,2)
6636 vv(2)=pizda(2,1)-pizda(1,2)
6637 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6638 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6640 eello6_graph3=-(s1+s2+s3+s4)
6642 eello6_graph3=-(s2+s3+s4)
6645 if (.not. calc_grad) return
6646 C Derivatives in gamma(k-1)
6647 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6648 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6649 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6650 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6651 C Derivatives in gamma(l-1)
6652 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6653 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6654 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6655 vv(1)=pizda(1,1)+pizda(2,2)
6656 vv(2)=pizda(2,1)-pizda(1,2)
6657 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6658 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6659 C Cartesian derivatives.
6665 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6667 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6670 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6672 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6673 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6675 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6676 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6678 vv(1)=pizda(1,1)+pizda(2,2)
6679 vv(2)=pizda(2,1)-pizda(1,2)
6680 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6682 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6684 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6687 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6689 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6691 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6697 c----------------------------------------------------------------------------
6698 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6699 implicit real*8 (a-h,o-z)
6700 include 'DIMENSIONS'
6701 include 'sizesclu.dat'
6702 include 'COMMON.IOUNITS'
6703 include 'COMMON.CHAIN'
6704 include 'COMMON.DERIV'
6705 include 'COMMON.INTERACT'
6706 include 'COMMON.CONTACTS'
6707 include 'COMMON.TORSION'
6708 include 'COMMON.VAR'
6709 include 'COMMON.GEO'
6710 include 'COMMON.FFIELD'
6711 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6712 & auxvec1(2),auxmat1(2,2)
6714 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6716 C Parallel Antiparallel C
6722 C \ j|/k\| \ |/k\|l C
6727 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6729 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6730 C energy moment and not to the cluster cumulant.
6731 cd write (2,*) 'eello_graph4: wturn6',wturn6
6732 iti=itortyp(itype(i))
6733 itj=itortyp(itype(j))
6734 if (j.lt.nres-1) then
6735 itj1=itortyp(itype(j+1))
6739 itk=itortyp(itype(k))
6740 if (k.lt.nres-1) then
6741 itk1=itortyp(itype(k+1))
6745 itl=itortyp(itype(l))
6746 if (l.lt.nres-1) then
6747 itl1=itortyp(itype(l+1))
6751 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6752 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6753 cd & ' itl',itl,' itl1',itl1
6756 s1=dip(3,jj,i)*dip(3,kk,k)
6758 s1=dip(2,jj,j)*dip(2,kk,l)
6761 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6762 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6764 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6765 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6767 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6768 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6770 call transpose2(EUg(1,1,k),auxmat(1,1))
6771 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6772 vv(1)=pizda(1,1)-pizda(2,2)
6773 vv(2)=pizda(2,1)+pizda(1,2)
6774 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6775 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6777 eello6_graph4=-(s1+s2+s3+s4)
6779 eello6_graph4=-(s2+s3+s4)
6781 if (.not. calc_grad) return
6782 C Derivatives in gamma(i-1)
6786 s1=dipderg(2,jj,i)*dip(3,kk,k)
6788 s1=dipderg(4,jj,j)*dip(2,kk,l)
6791 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6793 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6794 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6796 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6797 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6799 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6800 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6801 cd write (2,*) 'turn6 derivatives'
6803 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6805 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6809 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6811 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6815 C Derivatives in gamma(k-1)
6818 s1=dip(3,jj,i)*dipderg(2,kk,k)
6820 s1=dip(2,jj,j)*dipderg(4,kk,l)
6823 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6824 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6826 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6827 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6829 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6830 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6832 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6833 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6834 vv(1)=pizda(1,1)-pizda(2,2)
6835 vv(2)=pizda(2,1)+pizda(1,2)
6836 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6837 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6839 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6841 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6845 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6847 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6850 C Derivatives in gamma(j-1) or gamma(l-1)
6851 if (l.eq.j+1 .and. l.gt.1) then
6852 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6853 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6854 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6855 vv(1)=pizda(1,1)-pizda(2,2)
6856 vv(2)=pizda(2,1)+pizda(1,2)
6857 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6858 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6859 else if (j.gt.1) then
6860 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6861 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6862 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6863 vv(1)=pizda(1,1)-pizda(2,2)
6864 vv(2)=pizda(2,1)+pizda(1,2)
6865 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6866 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6867 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6869 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6872 C Cartesian derivatives.
6879 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6881 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6885 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6887 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6891 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6893 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6895 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6896 & b1(1,itj1),auxvec(1))
6897 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6899 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6900 & b1(1,itl1),auxvec(1))
6901 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6903 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6905 vv(1)=pizda(1,1)-pizda(2,2)
6906 vv(2)=pizda(2,1)+pizda(1,2)
6907 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6909 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6911 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6914 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6917 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6920 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6922 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6924 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6928 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6930 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6933 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6935 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6943 c----------------------------------------------------------------------------
6944 double precision function eello_turn6(i,jj,kk)
6945 implicit real*8 (a-h,o-z)
6946 include 'DIMENSIONS'
6947 include 'sizesclu.dat'
6948 include 'COMMON.IOUNITS'
6949 include 'COMMON.CHAIN'
6950 include 'COMMON.DERIV'
6951 include 'COMMON.INTERACT'
6952 include 'COMMON.CONTACTS'
6953 include 'COMMON.TORSION'
6954 include 'COMMON.VAR'
6955 include 'COMMON.GEO'
6956 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6957 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6959 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6960 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6961 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6962 C the respective energy moment and not to the cluster cumulant.
6967 iti=itortyp(itype(i))
6968 itk=itortyp(itype(k))
6969 itk1=itortyp(itype(k+1))
6970 itl=itortyp(itype(l))
6971 itj=itortyp(itype(j))
6972 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6973 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6974 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6979 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6981 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6985 derx_turn(lll,kkk,iii)=0.0d0
6992 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6994 cd write (2,*) 'eello6_5',eello6_5
6996 call transpose2(AEA(1,1,1),auxmat(1,1))
6997 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
6998 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
6999 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7003 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7004 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7005 s2 = scalar2(b1(1,itk),vtemp1(1))
7007 call transpose2(AEA(1,1,2),atemp(1,1))
7008 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7009 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7010 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7014 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7015 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7016 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7018 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7019 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7020 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7021 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7022 ss13 = scalar2(b1(1,itk),vtemp4(1))
7023 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7027 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7033 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7035 C Derivatives in gamma(i+2)
7037 call transpose2(AEA(1,1,1),auxmatd(1,1))
7038 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7039 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7040 call transpose2(AEAderg(1,1,2),atempd(1,1))
7041 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7042 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7046 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7047 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7048 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7054 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7055 C Derivatives in gamma(i+3)
7057 call transpose2(AEA(1,1,1),auxmatd(1,1))
7058 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7059 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7060 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7064 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7065 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7066 s2d = scalar2(b1(1,itk),vtemp1d(1))
7068 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7069 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7071 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7073 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7074 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7075 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7085 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7086 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7088 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7089 & -0.5d0*ekont*(s2d+s12d)
7091 C Derivatives in gamma(i+4)
7092 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7093 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7094 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7096 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7097 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7098 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7108 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7110 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7112 C Derivatives in gamma(i+5)
7114 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7115 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7116 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7120 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7121 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7122 s2d = scalar2(b1(1,itk),vtemp1d(1))
7124 call transpose2(AEA(1,1,2),atempd(1,1))
7125 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7126 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7130 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7131 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7133 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7134 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7135 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7145 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7146 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7148 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7149 & -0.5d0*ekont*(s2d+s12d)
7151 C Cartesian derivatives
7156 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7157 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7158 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7162 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7163 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7165 s2d = scalar2(b1(1,itk),vtemp1d(1))
7167 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7168 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7169 s8d = -(atempd(1,1)+atempd(2,2))*
7170 & scalar2(cc(1,1,itl),vtemp2(1))
7174 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7176 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7177 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7184 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7187 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7191 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7192 & - 0.5d0*(s8d+s12d)
7194 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7203 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7205 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7206 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7207 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7208 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7209 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7211 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7212 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7213 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7217 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7218 cd & 16*eel_turn6_num
7220 if (j.lt.nres-1) then
7227 if (l.lt.nres-1) then
7235 ggg1(ll)=eel_turn6*g_contij(ll,1)
7236 ggg2(ll)=eel_turn6*g_contij(ll,2)
7237 ghalf=0.5d0*ggg1(ll)
7239 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7240 & +ekont*derx_turn(ll,2,1)
7241 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7242 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7243 & +ekont*derx_turn(ll,4,1)
7244 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7245 ghalf=0.5d0*ggg2(ll)
7247 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7248 & +ekont*derx_turn(ll,2,2)
7249 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7250 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7251 & +ekont*derx_turn(ll,4,2)
7252 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7257 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7262 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7268 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7273 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7277 cd write (2,*) iii,g_corr6_loc(iii)
7280 eello_turn6=ekont*eel_turn6
7281 cd write (2,*) 'ekont',ekont
7282 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7285 crc-------------------------------------------------
7286 SUBROUTINE MATVEC2(A1,V1,V2)
7287 implicit real*8 (a-h,o-z)
7288 include 'DIMENSIONS'
7289 DIMENSION A1(2,2),V1(2),V2(2)
7293 c 3 VI=VI+A1(I,K)*V1(K)
7297 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7298 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7303 C---------------------------------------
7304 SUBROUTINE MATMAT2(A1,A2,A3)
7305 implicit real*8 (a-h,o-z)
7306 include 'DIMENSIONS'
7307 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7308 c DIMENSION AI3(2,2)
7312 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7318 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7319 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7320 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7321 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7329 c-------------------------------------------------------------------------
7330 double precision function scalar2(u,v)
7332 double precision u(2),v(2)
7335 scalar2=u(1)*v(1)+u(2)*v(2)
7339 C-----------------------------------------------------------------------------
7341 subroutine transpose2(a,at)
7343 double precision a(2,2),at(2,2)
7350 c--------------------------------------------------------------------------
7351 subroutine transpose(n,a,at)
7354 double precision a(n,n),at(n,n)
7362 C---------------------------------------------------------------------------
7363 subroutine prodmat3(a1,a2,kk,transp,prod)
7366 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7368 crc double precision auxmat(2,2),prod_(2,2)
7371 crc call transpose2(kk(1,1),auxmat(1,1))
7372 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7373 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7375 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7376 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7377 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7378 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7379 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7380 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7381 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7382 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7385 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7386 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7388 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7389 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7390 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7391 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7392 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7393 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7394 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7395 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7398 c call transpose2(a2(1,1),a2t(1,1))
7401 crc print *,((prod_(i,j),i=1,2),j=1,2)
7402 crc print *,((prod(i,j),i=1,2),j=1,2)
7406 C-----------------------------------------------------------------------------
7407 double precision function scalar(u,v)
7409 double precision u(3),v(3)