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 include 'COMMON.CONTROL'
25 double precision fact(5)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 C Gay-Berne potential (shifted LJ, angular dependence).
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor,fact(1))
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
106 c write(iout,*) "TEST_ENE",constr_homology
107 if (constr_homology.ge.1) then
108 call e_modeller(ehomology_constr)
110 ehomology_constr=0.0d0
112 c write(iout,*) "TEST_ENE",ehomology_constr
116 C call multibody(ecorr)
121 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*ees+wvdwpp*evdw1
122 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
123 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
124 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
125 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
126 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
127 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
129 etot=wsc*evdw+wscp*evdw2+welec*fact(1)*(ees+evdw1)
130 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
131 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
132 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
133 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
134 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
135 & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr
140 energia(2)=evdw2-evdw2_14
157 energia(8)=eello_turn3
158 energia(9)=eello_turn4
167 energia(20)=edihcnstr
168 energia(21)=ehomology_constr
170 cc if (dyn_ss) call dyn_set_nss
174 idumm=proc_proc(etot,i)
176 call proc_proc(etot,i)
178 if(i.eq.1)energia(0)=1.0d+99
184 C Sum up the components of the Cartesian gradient.
189 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
190 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
192 & wstrain*ghpbc(j,i)+
193 & wcorr*fact(3)*gradcorr(j,i)+
194 & wel_loc*fact(2)*gel_loc(j,i)+
195 & wturn3*fact(2)*gcorr3_turn(j,i)+
196 & wturn4*fact(3)*gcorr4_turn(j,i)+
197 & wcorr5*fact(4)*gradcorr5(j,i)+
198 & wcorr6*fact(5)*gradcorr6(j,i)+
199 & wturn6*fact(5)*gcorr6_turn(j,i)+
200 & wsccor*fact(2)*gsccorc(j,i)
201 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
203 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
208 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
209 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
211 & wcorr*fact(3)*gradcorr(j,i)+
212 & wel_loc*fact(2)*gel_loc(j,i)+
213 & wturn3*fact(2)*gcorr3_turn(j,i)+
214 & wturn4*fact(3)*gcorr4_turn(j,i)+
215 & wcorr5*fact(4)*gradcorr5(j,i)+
216 & wcorr6*fact(5)*gradcorr6(j,i)+
217 & wturn6*fact(5)*gcorr6_turn(j,i)+
218 & wsccor*fact(2)*gsccorc(j,i)
219 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
221 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)
224 cd print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3),
225 cd & (gradc(k,i),k=1,3)
230 cd write (iout,*) i,g_corr5_loc(i)
231 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
232 & +wcorr5*fact(4)*g_corr5_loc(i)
233 & +wcorr6*fact(5)*g_corr6_loc(i)
234 & +wturn4*fact(3)*gel_loc_turn4(i)
235 & +wturn3*fact(2)*gel_loc_turn3(i)
236 & +wturn6*fact(5)*gel_loc_turn6(i)
237 & +wel_loc*fact(2)*gel_loc_loc(i)
238 & +wsccor*fact(1)*gsccor_loc(i)
241 cd call enerprint(energia(0),fact)
246 C------------------------------------------------------------------------
247 subroutine enerprint(energia,fact)
248 implicit real*8 (a-h,o-z)
250 include 'sizesclu.dat'
251 include 'COMMON.IOUNITS'
252 include 'COMMON.FFIELD'
253 include 'COMMON.SBRIDGE'
254 double precision energia(0:max_ene),fact(5)
258 evdw2=energia(2)+energia(17)
270 eello_turn3=energia(8)
271 eello_turn4=energia(9)
272 eello_turn6=energia(10)
279 edihcnstr=energia(20)
281 ehomology_constr=energia(21)
284 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
286 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
287 & etors_d,wtor_d*fact(2),ehpb,wstrain,
288 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
289 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
290 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
291 & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss,etot
292 10 format (/'Virtual-chain energies:'//
293 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
294 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
295 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
296 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
297 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
298 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
299 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
300 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
301 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
302 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
303 & ' (SS bridges & dist. cnstr.)'/
304 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
305 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
306 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
307 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
308 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
309 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
310 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
311 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
312 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
313 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
314 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
315 & 'ETOT= ',1pE16.6,' (total)')
317 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
318 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
319 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
320 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
321 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
322 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
323 & edihcnstr,ehomology_constr,ebr*nss,etot
324 10 format (/'Virtual-chain energies:'//
325 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
326 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
327 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
328 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
329 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
330 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
331 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
332 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
333 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
334 & ' (SS bridges & dist. cnstr.)'/
335 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
336 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
337 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
338 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
339 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
340 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
341 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
342 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
343 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
344 & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
345 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
346 & 'ETOT= ',1pE16.6,' (total)')
350 C-----------------------------------------------------------------------
353 C This subroutine calculates the interaction energy of nonbonded side chains
354 C assuming the LJ potential of interaction.
356 implicit real*8 (a-h,o-z)
358 include 'sizesclu.dat'
359 c include "DIMENSIONS.COMPAR"
360 parameter (accur=1.0d-10)
363 include 'COMMON.LOCAL'
364 include 'COMMON.CHAIN'
365 include 'COMMON.DERIV'
366 include 'COMMON.INTERACT'
367 include 'COMMON.TORSION'
368 include 'COMMON.SBRIDGE'
369 include 'COMMON.NAMES'
370 include 'COMMON.IOUNITS'
371 include 'COMMON.CONTACTS'
375 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
386 C Calculate SC interaction energy.
389 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
390 cd & 'iend=',iend(i,iint)
391 do j=istart(i,iint),iend(i,iint)
396 C Change 12/1/95 to calculate four-body interactions
397 rij=xj*xj+yj*yj+zj*zj
399 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
400 eps0ij=eps(itypi,itypj)
402 e1=fac*fac*aa(itypi,itypj)
403 e2=fac*bb(itypi,itypj)
405 ij=icant(itypi,itypj)
406 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
407 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
408 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
409 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
410 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
411 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
415 C Calculate the components of the gradient in DC and X
417 fac=-rrij*(e1+evdwij)
422 gvdwx(k,i)=gvdwx(k,i)-gg(k)
423 gvdwx(k,j)=gvdwx(k,j)+gg(k)
427 gvdwc(l,k)=gvdwc(l,k)+gg(l)
432 C 12/1/95, revised on 5/20/97
434 C Calculate the contact function. The ith column of the array JCONT will
435 C contain the numbers of atoms that make contacts with the atom I (of numbers
436 C greater than I). The arrays FACONT and GACONT will contain the values of
437 C the contact function and its derivative.
439 C Uncomment next line, if the correlation interactions include EVDW explicitly.
440 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
441 C Uncomment next line, if the correlation interactions are contact function only
442 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
444 sigij=sigma(itypi,itypj)
445 r0ij=rs0(itypi,itypj)
447 C Check whether the SC's are not too far to make a contact.
450 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
451 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
453 if (fcont.gt.0.0D0) then
454 C If the SC-SC distance if close to sigma, apply spline.
455 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
456 cAdam & fcont1,fprimcont1)
457 cAdam fcont1=1.0d0-fcont1
458 cAdam if (fcont1.gt.0.0d0) then
459 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
460 cAdam fcont=fcont*fcont1
462 C Uncomment following 4 lines to have the geometric average of the epsilon0's
463 cga eps0ij=1.0d0/dsqrt(eps0ij)
465 cga gg(k)=gg(k)*eps0ij
467 cga eps0ij=-evdwij*eps0ij
468 C Uncomment for AL's type of SC correlation interactions.
470 num_conti=num_conti+1
472 facont(num_conti,i)=fcont*eps0ij
473 fprimcont=eps0ij*fprimcont/rij
475 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
476 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
477 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
478 C Uncomment following 3 lines for Skolnick's type of SC correlation.
479 gacont(1,num_conti,i)=-fprimcont*xj
480 gacont(2,num_conti,i)=-fprimcont*yj
481 gacont(3,num_conti,i)=-fprimcont*zj
482 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
483 cd write (iout,'(2i3,3f10.5)')
484 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
490 num_cont(i)=num_conti
495 gvdwc(j,i)=expon*gvdwc(j,i)
496 gvdwx(j,i)=expon*gvdwx(j,i)
500 C******************************************************************************
504 C To save time, the factor of EXPON has been extracted from ALL components
505 C of GVDWC and GRADX. Remember to multiply them by this factor before further
508 C******************************************************************************
511 C-----------------------------------------------------------------------------
512 subroutine eljk(evdw)
514 C This subroutine calculates the interaction energy of nonbonded side chains
515 C assuming the LJK potential of interaction.
517 implicit real*8 (a-h,o-z)
519 include 'sizesclu.dat'
520 c include "DIMENSIONS.COMPAR"
523 include 'COMMON.LOCAL'
524 include 'COMMON.CHAIN'
525 include 'COMMON.DERIV'
526 include 'COMMON.INTERACT'
527 include 'COMMON.IOUNITS'
528 include 'COMMON.NAMES'
533 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
542 C Calculate SC interaction energy.
545 do j=istart(i,iint),iend(i,iint)
550 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
552 e_augm=augm(itypi,itypj)*fac_augm
555 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
556 fac=r_shift_inv**expon
557 e1=fac*fac*aa(itypi,itypj)
558 e2=fac*bb(itypi,itypj)
560 ij=icant(itypi,itypj)
561 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
562 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
563 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
564 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
565 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
566 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
567 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
571 C Calculate the components of the gradient in DC and X
573 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
578 gvdwx(k,i)=gvdwx(k,i)-gg(k)
579 gvdwx(k,j)=gvdwx(k,j)+gg(k)
583 gvdwc(l,k)=gvdwc(l,k)+gg(l)
593 gvdwc(j,i)=expon*gvdwc(j,i)
594 gvdwx(j,i)=expon*gvdwx(j,i)
600 C-----------------------------------------------------------------------------
603 C This subroutine calculates the interaction energy of nonbonded side chains
604 C assuming the Berne-Pechukas potential of interaction.
606 implicit real*8 (a-h,o-z)
608 include 'sizesclu.dat'
609 c include "DIMENSIONS.COMPAR"
612 include 'COMMON.LOCAL'
613 include 'COMMON.CHAIN'
614 include 'COMMON.DERIV'
615 include 'COMMON.NAMES'
616 include 'COMMON.INTERACT'
617 include 'COMMON.IOUNITS'
618 include 'COMMON.CALC'
620 c double precision rrsave(maxdim)
625 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
627 c if (icall.eq.0) then
639 dxi=dc_norm(1,nres+i)
640 dyi=dc_norm(2,nres+i)
641 dzi=dc_norm(3,nres+i)
642 dsci_inv=vbld_inv(i+nres)
644 C Calculate SC interaction energy.
647 do j=istart(i,iint),iend(i,iint)
650 dscj_inv=vbld_inv(j+nres)
651 chi1=chi(itypi,itypj)
652 chi2=chi(itypj,itypi)
659 alf12=0.5D0*(alf1+alf2)
660 C For diagnostics only!!!
673 dxj=dc_norm(1,nres+j)
674 dyj=dc_norm(2,nres+j)
675 dzj=dc_norm(3,nres+j)
676 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
677 cd if (icall.eq.0) then
683 C Calculate the angle-dependent terms of energy & contributions to derivatives.
685 C Calculate whole angle-dependent part of epsilon and contributions
687 fac=(rrij*sigsq)**expon2
688 e1=fac*fac*aa(itypi,itypj)
689 e2=fac*bb(itypi,itypj)
690 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
691 eps2der=evdwij*eps3rt
692 eps3der=evdwij*eps2rt
693 evdwij=evdwij*eps2rt*eps3rt
694 ij=icant(itypi,itypj)
695 aux=eps1*eps2rt**2*eps3rt**2
699 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
700 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
701 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
702 cd & restyp(itypi),i,restyp(itypj),j,
703 cd & epsi,sigm,chi1,chi2,chip1,chip2,
704 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
705 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
708 C Calculate gradient components.
709 e1=e1*eps1*eps2rt**2*eps3rt**2
710 fac=-expon*(e1+evdwij)
713 C Calculate radial part of the gradient
717 C Calculate the angular part of the gradient and sum add the contributions
718 C to the appropriate components of the Cartesian gradient.
727 C-----------------------------------------------------------------------------
730 C This subroutine calculates the interaction energy of nonbonded side chains
731 C assuming the Gay-Berne potential of interaction.
733 implicit real*8 (a-h,o-z)
735 include 'sizesclu.dat'
736 c include "DIMENSIONS.COMPAR"
739 include 'COMMON.LOCAL'
740 include 'COMMON.CHAIN'
741 include 'COMMON.DERIV'
742 include 'COMMON.NAMES'
743 include 'COMMON.INTERACT'
744 include 'COMMON.IOUNITS'
745 include 'COMMON.CALC'
746 include 'COMMON.SBRIDGE'
752 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
755 c if (icall.gt.0) lprn=.true.
763 dxi=dc_norm(1,nres+i)
764 dyi=dc_norm(2,nres+i)
765 dzi=dc_norm(3,nres+i)
766 dsci_inv=vbld_inv(i+nres)
768 C Calculate SC interaction energy.
771 do j=istart(i,iint),iend(i,iint)
772 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
773 call dyn_ssbond_ene(i,j,evdwij)
775 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
776 c & 'evdw',i,j,evdwij,' ss'
780 dscj_inv=vbld_inv(j+nres)
781 sig0ij=sigma(itypi,itypj)
782 chi1=chi(itypi,itypj)
783 chi2=chi(itypj,itypi)
790 alf12=0.5D0*(alf1+alf2)
791 C For diagnostics only!!!
804 dxj=dc_norm(1,nres+j)
805 dyj=dc_norm(2,nres+j)
806 dzj=dc_norm(3,nres+j)
807 c write (iout,*) i,j,xj,yj,zj
808 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
810 C Calculate angle-dependent terms of energy and contributions to their
814 sig=sig0ij*dsqrt(sigsq)
815 rij_shift=1.0D0/rij-sig+sig0ij
816 C I hate to put IF's in the loops, but here don't have another choice!!!!
817 if (rij_shift.le.0.0D0) then
822 c---------------------------------------------------------------
823 rij_shift=1.0D0/rij_shift
825 e1=fac*fac*aa(itypi,itypj)
826 e2=fac*bb(itypi,itypj)
827 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
828 eps2der=evdwij*eps3rt
829 eps3der=evdwij*eps2rt
830 evdwij=evdwij*eps2rt*eps3rt
832 ij=icant(itypi,itypj)
833 aux=eps1*eps2rt**2*eps3rt**2
834 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
835 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
836 c & aux*e2/eps(itypi,itypj)
838 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
839 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
840 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
841 & restyp(itypi),i,restyp(itypj),j,
842 & epsi,sigm,chi1,chi2,chip1,chip2,
843 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
844 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
848 C Calculate gradient components.
849 e1=e1*eps1*eps2rt**2*eps3rt**2
850 fac=-expon*(e1+evdwij)*rij_shift
853 C Calculate the radial part of the gradient
857 C Calculate angular part of the gradient.
866 C-----------------------------------------------------------------------------
867 subroutine egbv(evdw)
869 C This subroutine calculates the interaction energy of nonbonded side chains
870 C assuming the Gay-Berne-Vorobjev potential of interaction.
872 implicit real*8 (a-h,o-z)
874 include 'sizesclu.dat'
875 c include "DIMENSIONS.COMPAR"
878 include 'COMMON.LOCAL'
879 include 'COMMON.CHAIN'
880 include 'COMMON.DERIV'
881 include 'COMMON.NAMES'
882 include 'COMMON.INTERACT'
883 include 'COMMON.IOUNITS'
884 include 'COMMON.CALC'
885 include 'COMMON.SBRIDGE'
891 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
894 c if (icall.gt.0) lprn=.true.
902 dxi=dc_norm(1,nres+i)
903 dyi=dc_norm(2,nres+i)
904 dzi=dc_norm(3,nres+i)
905 dsci_inv=vbld_inv(i+nres)
907 C Calculate SC interaction energy.
910 do j=istart(i,iint),iend(i,iint)
911 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
912 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
913 call dyn_ssbond_ene(i,j,evdwij)
915 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
916 c & 'evdw',i,j,evdwij,' ss'
920 dscj_inv=vbld_inv(j+nres)
921 sig0ij=sigma(itypi,itypj)
923 chi1=chi(itypi,itypj)
924 chi2=chi(itypj,itypi)
931 alf12=0.5D0*(alf1+alf2)
932 C For diagnostics only!!!
945 dxj=dc_norm(1,nres+j)
946 dyj=dc_norm(2,nres+j)
947 dzj=dc_norm(3,nres+j)
948 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
950 C Calculate angle-dependent terms of energy and contributions to their
954 sig=sig0ij*dsqrt(sigsq)
955 rij_shift=1.0D0/rij-sig+r0ij
956 C I hate to put IF's in the loops, but here don't have another choice!!!!
957 if (rij_shift.le.0.0D0) then
962 c---------------------------------------------------------------
963 rij_shift=1.0D0/rij_shift
965 e1=fac*fac*aa(itypi,itypj)
966 e2=fac*bb(itypi,itypj)
967 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
968 eps2der=evdwij*eps3rt
969 eps3der=evdwij*eps2rt
971 e_augm=augm(itypi,itypj)*fac_augm
972 evdwij=evdwij*eps2rt*eps3rt
973 evdw=evdw+evdwij+e_augm
974 ij=icant(itypi,itypj)
975 aux=eps1*eps2rt**2*eps3rt**2
977 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
978 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
979 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
980 c & restyp(itypi),i,restyp(itypj),j,
981 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
982 c & chi1,chi2,chip1,chip2,
983 c & eps1,eps2rt**2,eps3rt**2,
984 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
988 C Calculate gradient components.
989 e1=e1*eps1*eps2rt**2*eps3rt**2
990 fac=-expon*(e1+evdwij)*rij_shift
992 fac=rij*fac-2*expon*rrij*e_augm
993 C Calculate the radial part of the gradient
997 C Calculate angular part of the gradient.
1006 C-----------------------------------------------------------------------------
1007 subroutine sc_angular
1008 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1009 C om12. Called by ebp, egb, and egbv.
1011 include 'COMMON.CALC'
1015 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1016 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1017 om12=dxi*dxj+dyi*dyj+dzi*dzj
1019 C Calculate eps1(om12) and its derivative in om12
1020 faceps1=1.0D0-om12*chiom12
1021 faceps1_inv=1.0D0/faceps1
1022 eps1=dsqrt(faceps1_inv)
1023 C Following variable is eps1*deps1/dom12
1024 eps1_om12=faceps1_inv*chiom12
1025 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1030 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1031 sigsq=1.0D0-facsig*faceps1_inv
1032 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1033 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1034 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1035 C Calculate eps2 and its derivatives in om1, om2, and om12.
1038 chipom12=chip12*om12
1039 facp=1.0D0-om12*chipom12
1041 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1042 C Following variable is the square root of eps2
1043 eps2rt=1.0D0-facp1*facp_inv
1044 C Following three variables are the derivatives of the square root of eps
1045 C in om1, om2, and om12.
1046 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1047 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1048 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1049 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1050 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1051 C Calculate whole angle-dependent part of epsilon and contributions
1052 C to its derivatives
1055 C----------------------------------------------------------------------------
1057 implicit real*8 (a-h,o-z)
1058 include 'DIMENSIONS'
1059 include 'sizesclu.dat'
1060 include 'COMMON.CHAIN'
1061 include 'COMMON.DERIV'
1062 include 'COMMON.CALC'
1063 double precision dcosom1(3),dcosom2(3)
1064 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1065 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1066 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1067 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1069 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1070 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1073 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1076 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1077 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1078 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1079 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1080 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1081 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1084 C Calculate the components of the gradient in DC and X
1088 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1093 c------------------------------------------------------------------------------
1094 subroutine vec_and_deriv
1095 implicit real*8 (a-h,o-z)
1096 include 'DIMENSIONS'
1097 include 'sizesclu.dat'
1098 include 'COMMON.IOUNITS'
1099 include 'COMMON.GEO'
1100 include 'COMMON.VAR'
1101 include 'COMMON.LOCAL'
1102 include 'COMMON.CHAIN'
1103 include 'COMMON.VECTORS'
1104 include 'COMMON.DERIV'
1105 include 'COMMON.INTERACT'
1106 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1107 C Compute the local reference systems. For reference system (i), the
1108 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1109 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1111 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1112 if (i.eq.nres-1) then
1113 C Case of the last full residue
1114 C Compute the Z-axis
1115 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1116 costh=dcos(pi-theta(nres))
1117 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1122 C Compute the derivatives of uz
1124 uzder(2,1,1)=-dc_norm(3,i-1)
1125 uzder(3,1,1)= dc_norm(2,i-1)
1126 uzder(1,2,1)= dc_norm(3,i-1)
1128 uzder(3,2,1)=-dc_norm(1,i-1)
1129 uzder(1,3,1)=-dc_norm(2,i-1)
1130 uzder(2,3,1)= dc_norm(1,i-1)
1133 uzder(2,1,2)= dc_norm(3,i)
1134 uzder(3,1,2)=-dc_norm(2,i)
1135 uzder(1,2,2)=-dc_norm(3,i)
1137 uzder(3,2,2)= dc_norm(1,i)
1138 uzder(1,3,2)= dc_norm(2,i)
1139 uzder(2,3,2)=-dc_norm(1,i)
1142 C Compute the Y-axis
1145 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1148 C Compute the derivatives of uy
1151 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1152 & -dc_norm(k,i)*dc_norm(j,i-1)
1153 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1155 uyder(j,j,1)=uyder(j,j,1)-costh
1156 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1161 uygrad(l,k,j,i)=uyder(l,k,j)
1162 uzgrad(l,k,j,i)=uzder(l,k,j)
1166 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1167 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1168 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1169 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1173 C Compute the Z-axis
1174 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1175 costh=dcos(pi-theta(i+2))
1176 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1181 C Compute the derivatives of uz
1183 uzder(2,1,1)=-dc_norm(3,i+1)
1184 uzder(3,1,1)= dc_norm(2,i+1)
1185 uzder(1,2,1)= dc_norm(3,i+1)
1187 uzder(3,2,1)=-dc_norm(1,i+1)
1188 uzder(1,3,1)=-dc_norm(2,i+1)
1189 uzder(2,3,1)= dc_norm(1,i+1)
1192 uzder(2,1,2)= dc_norm(3,i)
1193 uzder(3,1,2)=-dc_norm(2,i)
1194 uzder(1,2,2)=-dc_norm(3,i)
1196 uzder(3,2,2)= dc_norm(1,i)
1197 uzder(1,3,2)= dc_norm(2,i)
1198 uzder(2,3,2)=-dc_norm(1,i)
1201 C Compute the Y-axis
1204 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1207 C Compute the derivatives of uy
1210 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1211 & -dc_norm(k,i)*dc_norm(j,i+1)
1212 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1214 uyder(j,j,1)=uyder(j,j,1)-costh
1215 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1220 uygrad(l,k,j,i)=uyder(l,k,j)
1221 uzgrad(l,k,j,i)=uzder(l,k,j)
1225 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1226 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1227 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1228 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1234 vbld_inv_temp(1)=vbld_inv(i+1)
1235 if (i.lt.nres-1) then
1236 vbld_inv_temp(2)=vbld_inv(i+2)
1238 vbld_inv_temp(2)=vbld_inv(i)
1243 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1244 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1252 C-----------------------------------------------------------------------------
1253 subroutine vec_and_deriv_test
1254 implicit real*8 (a-h,o-z)
1255 include 'DIMENSIONS'
1256 include 'sizesclu.dat'
1257 include 'COMMON.IOUNITS'
1258 include 'COMMON.GEO'
1259 include 'COMMON.VAR'
1260 include 'COMMON.LOCAL'
1261 include 'COMMON.CHAIN'
1262 include 'COMMON.VECTORS'
1263 dimension uyder(3,3,2),uzder(3,3,2)
1264 C Compute the local reference systems. For reference system (i), the
1265 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1266 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1268 if (i.eq.nres-1) then
1269 C Case of the last full residue
1270 C Compute the Z-axis
1271 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1272 costh=dcos(pi-theta(nres))
1273 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1274 c write (iout,*) 'fac',fac,
1275 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1276 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1280 C Compute the derivatives of uz
1282 uzder(2,1,1)=-dc_norm(3,i-1)
1283 uzder(3,1,1)= dc_norm(2,i-1)
1284 uzder(1,2,1)= dc_norm(3,i-1)
1286 uzder(3,2,1)=-dc_norm(1,i-1)
1287 uzder(1,3,1)=-dc_norm(2,i-1)
1288 uzder(2,3,1)= dc_norm(1,i-1)
1291 uzder(2,1,2)= dc_norm(3,i)
1292 uzder(3,1,2)=-dc_norm(2,i)
1293 uzder(1,2,2)=-dc_norm(3,i)
1295 uzder(3,2,2)= dc_norm(1,i)
1296 uzder(1,3,2)= dc_norm(2,i)
1297 uzder(2,3,2)=-dc_norm(1,i)
1299 C Compute the Y-axis
1301 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1304 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1305 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1306 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1308 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1311 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1312 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1315 c write (iout,*) 'facy',facy,
1316 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1317 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1319 uy(k,i)=facy*uy(k,i)
1321 C Compute the derivatives of uy
1324 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1325 & -dc_norm(k,i)*dc_norm(j,i-1)
1326 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1328 c uyder(j,j,1)=uyder(j,j,1)-costh
1329 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1330 uyder(j,j,1)=uyder(j,j,1)
1331 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1332 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1338 uygrad(l,k,j,i)=uyder(l,k,j)
1339 uzgrad(l,k,j,i)=uzder(l,k,j)
1343 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1344 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1345 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1346 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1349 C Compute the Z-axis
1350 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1351 costh=dcos(pi-theta(i+2))
1352 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1353 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1357 C Compute the derivatives of uz
1359 uzder(2,1,1)=-dc_norm(3,i+1)
1360 uzder(3,1,1)= dc_norm(2,i+1)
1361 uzder(1,2,1)= dc_norm(3,i+1)
1363 uzder(3,2,1)=-dc_norm(1,i+1)
1364 uzder(1,3,1)=-dc_norm(2,i+1)
1365 uzder(2,3,1)= dc_norm(1,i+1)
1368 uzder(2,1,2)= dc_norm(3,i)
1369 uzder(3,1,2)=-dc_norm(2,i)
1370 uzder(1,2,2)=-dc_norm(3,i)
1372 uzder(3,2,2)= dc_norm(1,i)
1373 uzder(1,3,2)= dc_norm(2,i)
1374 uzder(2,3,2)=-dc_norm(1,i)
1376 C Compute the Y-axis
1378 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1379 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1380 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1382 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1385 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1386 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1389 c write (iout,*) 'facy',facy,
1390 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1391 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1393 uy(k,i)=facy*uy(k,i)
1395 C Compute the derivatives of uy
1398 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1399 & -dc_norm(k,i)*dc_norm(j,i+1)
1400 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1402 c uyder(j,j,1)=uyder(j,j,1)-costh
1403 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1404 uyder(j,j,1)=uyder(j,j,1)
1405 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1406 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1412 uygrad(l,k,j,i)=uyder(l,k,j)
1413 uzgrad(l,k,j,i)=uzder(l,k,j)
1417 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1418 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1419 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1420 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1427 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1428 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1435 C-----------------------------------------------------------------------------
1436 subroutine check_vecgrad
1437 implicit real*8 (a-h,o-z)
1438 include 'DIMENSIONS'
1439 include 'sizesclu.dat'
1440 include 'COMMON.IOUNITS'
1441 include 'COMMON.GEO'
1442 include 'COMMON.VAR'
1443 include 'COMMON.LOCAL'
1444 include 'COMMON.CHAIN'
1445 include 'COMMON.VECTORS'
1446 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1447 dimension uyt(3,maxres),uzt(3,maxres)
1448 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1449 double precision delta /1.0d-7/
1452 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1453 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1454 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1455 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1456 cd & (dc_norm(if90,i),if90=1,3)
1457 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1458 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1459 cd write(iout,'(a)')
1465 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1466 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1479 cd write (iout,*) 'i=',i
1481 erij(k)=dc_norm(k,i)
1485 dc_norm(k,i)=erij(k)
1487 dc_norm(j,i)=dc_norm(j,i)+delta
1488 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1490 c dc_norm(k,i)=dc_norm(k,i)/fac
1492 c write (iout,*) (dc_norm(k,i),k=1,3)
1493 c write (iout,*) (erij(k),k=1,3)
1496 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1497 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1498 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1499 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1501 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1502 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1503 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1506 dc_norm(k,i)=erij(k)
1509 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1510 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1511 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1512 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1513 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1514 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1515 cd write (iout,'(a)')
1520 C--------------------------------------------------------------------------
1521 subroutine set_matrices
1522 implicit real*8 (a-h,o-z)
1523 include 'DIMENSIONS'
1524 include 'sizesclu.dat'
1525 include 'COMMON.IOUNITS'
1526 include 'COMMON.GEO'
1527 include 'COMMON.VAR'
1528 include 'COMMON.LOCAL'
1529 include 'COMMON.CHAIN'
1530 include 'COMMON.DERIV'
1531 include 'COMMON.INTERACT'
1532 include 'COMMON.CONTACTS'
1533 include 'COMMON.TORSION'
1534 include 'COMMON.VECTORS'
1535 include 'COMMON.FFIELD'
1536 double precision auxvec(2),auxmat(2,2)
1538 C Compute the virtual-bond-torsional-angle dependent quantities needed
1539 C to calculate the el-loc multibody terms of various order.
1542 if (i .lt. nres+1) then
1579 if (i .gt. 3 .and. i .lt. nres+1) then
1580 obrot_der(1,i-2)=-sin1
1581 obrot_der(2,i-2)= cos1
1582 Ugder(1,1,i-2)= sin1
1583 Ugder(1,2,i-2)=-cos1
1584 Ugder(2,1,i-2)=-cos1
1585 Ugder(2,2,i-2)=-sin1
1588 obrot2_der(1,i-2)=-dwasin2
1589 obrot2_der(2,i-2)= dwacos2
1590 Ug2der(1,1,i-2)= dwasin2
1591 Ug2der(1,2,i-2)=-dwacos2
1592 Ug2der(2,1,i-2)=-dwacos2
1593 Ug2der(2,2,i-2)=-dwasin2
1595 obrot_der(1,i-2)=0.0d0
1596 obrot_der(2,i-2)=0.0d0
1597 Ugder(1,1,i-2)=0.0d0
1598 Ugder(1,2,i-2)=0.0d0
1599 Ugder(2,1,i-2)=0.0d0
1600 Ugder(2,2,i-2)=0.0d0
1601 obrot2_der(1,i-2)=0.0d0
1602 obrot2_der(2,i-2)=0.0d0
1603 Ug2der(1,1,i-2)=0.0d0
1604 Ug2der(1,2,i-2)=0.0d0
1605 Ug2der(2,1,i-2)=0.0d0
1606 Ug2der(2,2,i-2)=0.0d0
1608 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1609 iti = itortyp(itype(i-2))
1613 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1614 iti1 = itortyp(itype(i-1))
1618 cd write (iout,*) '*******i',i,' iti1',iti
1619 cd write (iout,*) 'b1',b1(:,iti)
1620 cd write (iout,*) 'b2',b2(:,iti)
1621 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1622 if (i .gt. iatel_s+2) then
1623 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1624 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1625 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1626 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1627 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1628 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1629 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1639 DtUg2(l,k,i-2)=0.0d0
1643 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1644 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1645 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1646 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1647 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1648 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1649 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1651 muder(k,i-2)=Ub2der(k,i-2)
1653 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1654 iti1 = itortyp(itype(i-1))
1659 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1661 C Vectors and matrices dependent on a single virtual-bond dihedral.
1662 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1663 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1664 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1665 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1666 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1667 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1668 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1669 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1670 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1671 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1672 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1674 C Matrices dependent on two consecutive virtual-bond dihedrals.
1675 C The order of matrices is from left to right.
1677 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1678 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1679 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1680 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1681 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1682 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1683 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1684 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1687 cd iti = itortyp(itype(i))
1690 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1691 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1696 C--------------------------------------------------------------------------
1697 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1699 C This subroutine calculates the average interaction energy and its gradient
1700 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1701 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1702 C The potential depends both on the distance of peptide-group centers and on
1703 C the orientation of the CA-CA virtual bonds.
1705 implicit real*8 (a-h,o-z)
1706 include 'DIMENSIONS'
1707 include 'sizesclu.dat'
1708 include 'COMMON.CONTROL'
1709 include 'COMMON.IOUNITS'
1710 include 'COMMON.GEO'
1711 include 'COMMON.VAR'
1712 include 'COMMON.LOCAL'
1713 include 'COMMON.CHAIN'
1714 include 'COMMON.DERIV'
1715 include 'COMMON.INTERACT'
1716 include 'COMMON.CONTACTS'
1717 include 'COMMON.TORSION'
1718 include 'COMMON.VECTORS'
1719 include 'COMMON.FFIELD'
1720 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1721 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1722 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1723 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1724 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1725 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1726 double precision scal_el /0.5d0/
1728 C 13-go grudnia roku pamietnego...
1729 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1730 & 0.0d0,1.0d0,0.0d0,
1731 & 0.0d0,0.0d0,1.0d0/
1732 cd write(iout,*) 'In EELEC'
1734 cd write(iout,*) 'Type',i
1735 cd write(iout,*) 'B1',B1(:,i)
1736 cd write(iout,*) 'B2',B2(:,i)
1737 cd write(iout,*) 'CC',CC(:,:,i)
1738 cd write(iout,*) 'DD',DD(:,:,i)
1739 cd write(iout,*) 'EE',EE(:,:,i)
1741 cd call check_vecgrad
1743 if (icheckgrad.eq.1) then
1745 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1747 dc_norm(k,i)=dc(k,i)*fac
1749 c write (iout,*) 'i',i,' fac',fac
1752 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1753 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1754 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1755 cd if (wel_loc.gt.0.0d0) then
1756 if (icheckgrad.eq.1) then
1757 call vec_and_deriv_test
1764 cd write (iout,*) 'i=',i
1766 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1769 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1770 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1783 cd print '(a)','Enter EELEC'
1784 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1786 gel_loc_loc(i)=0.0d0
1789 do i=iatel_s,iatel_e
1790 if (itel(i).eq.0) goto 1215
1794 dx_normi=dc_norm(1,i)
1795 dy_normi=dc_norm(2,i)
1796 dz_normi=dc_norm(3,i)
1797 xmedi=c(1,i)+0.5d0*dxi
1798 ymedi=c(2,i)+0.5d0*dyi
1799 zmedi=c(3,i)+0.5d0*dzi
1801 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1802 do j=ielstart(i),ielend(i)
1803 if (itel(j).eq.0) goto 1216
1807 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1808 aaa=app(iteli,itelj)
1809 bbb=bpp(iteli,itelj)
1810 C Diagnostics only!!!
1816 ael6i=ael6(iteli,itelj)
1817 ael3i=ael3(iteli,itelj)
1821 dx_normj=dc_norm(1,j)
1822 dy_normj=dc_norm(2,j)
1823 dz_normj=dc_norm(3,j)
1824 xj=c(1,j)+0.5D0*dxj-xmedi
1825 yj=c(2,j)+0.5D0*dyj-ymedi
1826 zj=c(3,j)+0.5D0*dzj-zmedi
1827 rij=xj*xj+yj*yj+zj*zj
1833 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1834 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1835 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1836 fac=cosa-3.0D0*cosb*cosg
1838 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1839 if (j.eq.i+2) ev1=scal_el*ev1
1844 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1847 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1848 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1849 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1852 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1853 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1854 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1855 cd & xmedi,ymedi,zmedi,xj,yj,zj
1857 C Calculate contributions to the Cartesian gradient.
1860 facvdw=-6*rrmij*(ev1+evdwij)
1861 facel=-3*rrmij*(el1+eesij)
1868 * Radial derivatives. First process both termini of the fragment (i,j)
1875 gelc(k,i)=gelc(k,i)+ghalf
1876 gelc(k,j)=gelc(k,j)+ghalf
1879 * Loop over residues i+1 thru j-1.
1883 gelc(l,k)=gelc(l,k)+ggg(l)
1891 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1892 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1895 * Loop over residues i+1 thru j-1.
1899 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1906 fac=-3*rrmij*(facvdw+facvdw+facel)
1912 * Radial derivatives. First process both termini of the fragment (i,j)
1919 gelc(k,i)=gelc(k,i)+ghalf
1920 gelc(k,j)=gelc(k,j)+ghalf
1923 * Loop over residues i+1 thru j-1.
1927 gelc(l,k)=gelc(l,k)+ggg(l)
1934 ecosa=2.0D0*fac3*fac1+fac4
1937 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1938 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1940 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1941 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1943 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1944 cd & (dcosg(k),k=1,3)
1946 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1950 gelc(k,i)=gelc(k,i)+ghalf
1951 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1952 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1953 gelc(k,j)=gelc(k,j)+ghalf
1954 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1955 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1959 gelc(l,k)=gelc(l,k)+ggg(l)
1964 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1965 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
1966 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
1968 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
1969 C energy of a peptide unit is assumed in the form of a second-order
1970 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
1971 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
1972 C are computed for EVERY pair of non-contiguous peptide groups.
1974 if (j.lt.nres-1) then
1985 muij(kkk)=mu(k,i)*mu(l,j)
1988 cd write (iout,*) 'EELEC: i',i,' j',j
1989 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
1990 cd write(iout,*) 'muij',muij
1991 ury=scalar(uy(1,i),erij)
1992 urz=scalar(uz(1,i),erij)
1993 vry=scalar(uy(1,j),erij)
1994 vrz=scalar(uz(1,j),erij)
1995 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
1996 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
1997 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
1998 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
1999 C For diagnostics only
2004 fac=dsqrt(-ael6i)*r3ij
2005 cd write (2,*) 'fac=',fac
2006 C For diagnostics only
2012 cd write (iout,'(4i5,4f10.5)')
2013 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2014 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2015 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2016 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2017 cd write (iout,'(4f10.5)')
2018 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2019 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2020 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2021 cd write (iout,'(2i3,9f10.5/)') i,j,
2022 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2024 C Derivatives of the elements of A in virtual-bond vectors
2025 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2032 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2033 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2034 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2035 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2036 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2037 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2038 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2039 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2040 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2041 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2042 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2043 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2053 C Compute radial contributions to the gradient
2075 C Add the contributions coming from er
2078 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2079 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2080 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2081 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2084 C Derivatives in DC(i)
2085 ghalf1=0.5d0*agg(k,1)
2086 ghalf2=0.5d0*agg(k,2)
2087 ghalf3=0.5d0*agg(k,3)
2088 ghalf4=0.5d0*agg(k,4)
2089 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2090 & -3.0d0*uryg(k,2)*vry)+ghalf1
2091 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2092 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2093 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2094 & -3.0d0*urzg(k,2)*vry)+ghalf3
2095 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2096 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2097 C Derivatives in DC(i+1)
2098 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2099 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2100 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2101 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2102 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2103 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2104 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2105 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2106 C Derivatives in DC(j)
2107 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2108 & -3.0d0*vryg(k,2)*ury)+ghalf1
2109 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2110 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2111 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2112 & -3.0d0*vryg(k,2)*urz)+ghalf3
2113 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2114 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2115 C Derivatives in DC(j+1) or DC(nres-1)
2116 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2117 & -3.0d0*vryg(k,3)*ury)
2118 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2119 & -3.0d0*vrzg(k,3)*ury)
2120 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2121 & -3.0d0*vryg(k,3)*urz)
2122 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2123 & -3.0d0*vrzg(k,3)*urz)
2128 C Derivatives in DC(i+1)
2129 cd aggi1(k,1)=agg(k,1)
2130 cd aggi1(k,2)=agg(k,2)
2131 cd aggi1(k,3)=agg(k,3)
2132 cd aggi1(k,4)=agg(k,4)
2133 C Derivatives in DC(j)
2138 C Derivatives in DC(j+1)
2143 if (j.eq.nres-1 .and. i.lt.j-2) then
2145 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2146 cd aggj1(k,l)=agg(k,l)
2152 C Check the loc-el terms by numerical integration
2162 aggi(k,l)=-aggi(k,l)
2163 aggi1(k,l)=-aggi1(k,l)
2164 aggj(k,l)=-aggj(k,l)
2165 aggj1(k,l)=-aggj1(k,l)
2168 if (j.lt.nres-1) then
2174 aggi(k,l)=-aggi(k,l)
2175 aggi1(k,l)=-aggi1(k,l)
2176 aggj(k,l)=-aggj(k,l)
2177 aggj1(k,l)=-aggj1(k,l)
2188 aggi(k,l)=-aggi(k,l)
2189 aggi1(k,l)=-aggi1(k,l)
2190 aggj(k,l)=-aggj(k,l)
2191 aggj1(k,l)=-aggj1(k,l)
2197 IF (wel_loc.gt.0.0d0) THEN
2198 C Contribution to the local-electrostatic energy coming from the i-j pair
2199 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2201 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2202 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2203 eel_loc=eel_loc+eel_loc_ij
2204 C Partial derivatives in virtual-bond dihedral angles gamma
2207 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2208 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2209 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2210 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2211 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2212 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2213 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2214 cd write(iout,*) 'agg ',agg
2215 cd write(iout,*) 'aggi ',aggi
2216 cd write(iout,*) 'aggi1',aggi1
2217 cd write(iout,*) 'aggj ',aggj
2218 cd write(iout,*) 'aggj1',aggj1
2220 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2222 ggg(l)=agg(l,1)*muij(1)+
2223 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2227 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2230 C Remaining derivatives of eello
2232 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2233 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2234 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2235 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2236 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2237 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2238 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2239 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2243 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2244 C Contributions from turns
2249 call eturn34(i,j,eello_turn3,eello_turn4)
2251 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2252 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2254 C Calculate the contact function. The ith column of the array JCONT will
2255 C contain the numbers of atoms that make contacts with the atom I (of numbers
2256 C greater than I). The arrays FACONT and GACONT will contain the values of
2257 C the contact function and its derivative.
2258 c r0ij=1.02D0*rpp(iteli,itelj)
2259 c r0ij=1.11D0*rpp(iteli,itelj)
2260 r0ij=2.20D0*rpp(iteli,itelj)
2261 c r0ij=1.55D0*rpp(iteli,itelj)
2262 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2263 if (fcont.gt.0.0D0) then
2264 num_conti=num_conti+1
2265 if (num_conti.gt.maxconts) then
2266 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2267 & ' will skip next contacts for this conf.'
2269 jcont_hb(num_conti,i)=j
2270 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2271 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2272 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2274 d_cont(num_conti,i)=rij
2275 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2276 C --- Electrostatic-interaction matrix ---
2277 a_chuj(1,1,num_conti,i)=a22
2278 a_chuj(1,2,num_conti,i)=a23
2279 a_chuj(2,1,num_conti,i)=a32
2280 a_chuj(2,2,num_conti,i)=a33
2281 C --- Gradient of rij
2283 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2286 c a_chuj(1,1,num_conti,i)=-0.61d0
2287 c a_chuj(1,2,num_conti,i)= 0.4d0
2288 c a_chuj(2,1,num_conti,i)= 0.65d0
2289 c a_chuj(2,2,num_conti,i)= 0.50d0
2290 c else if (i.eq.2) then
2291 c a_chuj(1,1,num_conti,i)= 0.0d0
2292 c a_chuj(1,2,num_conti,i)= 0.0d0
2293 c a_chuj(2,1,num_conti,i)= 0.0d0
2294 c a_chuj(2,2,num_conti,i)= 0.0d0
2296 C --- and its gradients
2297 cd write (iout,*) 'i',i,' j',j
2299 cd write (iout,*) 'iii 1 kkk',kkk
2300 cd write (iout,*) agg(kkk,:)
2303 cd write (iout,*) 'iii 2 kkk',kkk
2304 cd write (iout,*) aggi(kkk,:)
2307 cd write (iout,*) 'iii 3 kkk',kkk
2308 cd write (iout,*) aggi1(kkk,:)
2311 cd write (iout,*) 'iii 4 kkk',kkk
2312 cd write (iout,*) aggj(kkk,:)
2315 cd write (iout,*) 'iii 5 kkk',kkk
2316 cd write (iout,*) aggj1(kkk,:)
2323 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2324 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2325 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2326 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2327 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2329 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2335 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2336 C Calculate contact energies
2338 wij=cosa-3.0D0*cosb*cosg
2341 c fac3=dsqrt(-ael6i)/r0ij**3
2342 fac3=dsqrt(-ael6i)*r3ij
2343 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2344 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2346 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2347 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2348 C Diagnostics. Comment out or remove after debugging!
2349 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2350 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2351 c ees0m(num_conti,i)=0.0D0
2353 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2354 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2355 facont_hb(num_conti,i)=fcont
2357 C Angular derivatives of the contact function
2358 ees0pij1=fac3/ees0pij
2359 ees0mij1=fac3/ees0mij
2360 fac3p=-3.0D0*fac3*rrmij
2361 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2362 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2364 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2365 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2366 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2367 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2368 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2369 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2370 ecosap=ecosa1+ecosa2
2371 ecosbp=ecosb1+ecosb2
2372 ecosgp=ecosg1+ecosg2
2373 ecosam=ecosa1-ecosa2
2374 ecosbm=ecosb1-ecosb2
2375 ecosgm=ecosg1-ecosg2
2384 fprimcont=fprimcont/rij
2385 cd facont_hb(num_conti,i)=1.0D0
2386 C Following line is for diagnostics.
2389 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2390 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2393 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2394 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2396 gggp(1)=gggp(1)+ees0pijp*xj
2397 gggp(2)=gggp(2)+ees0pijp*yj
2398 gggp(3)=gggp(3)+ees0pijp*zj
2399 gggm(1)=gggm(1)+ees0mijp*xj
2400 gggm(2)=gggm(2)+ees0mijp*yj
2401 gggm(3)=gggm(3)+ees0mijp*zj
2402 C Derivatives due to the contact function
2403 gacont_hbr(1,num_conti,i)=fprimcont*xj
2404 gacont_hbr(2,num_conti,i)=fprimcont*yj
2405 gacont_hbr(3,num_conti,i)=fprimcont*zj
2407 ghalfp=0.5D0*gggp(k)
2408 ghalfm=0.5D0*gggm(k)
2409 gacontp_hb1(k,num_conti,i)=ghalfp
2410 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2411 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2412 gacontp_hb2(k,num_conti,i)=ghalfp
2413 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2414 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2415 gacontp_hb3(k,num_conti,i)=gggp(k)
2416 gacontm_hb1(k,num_conti,i)=ghalfm
2417 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2418 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2419 gacontm_hb2(k,num_conti,i)=ghalfm
2420 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2421 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2422 gacontm_hb3(k,num_conti,i)=gggm(k)
2425 C Diagnostics. Comment out or remove after debugging!
2427 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2428 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2429 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2430 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2431 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2432 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2435 endif ! num_conti.le.maxconts
2440 num_cont_hb(i)=num_conti
2444 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2445 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2447 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2448 ccc eel_loc=eel_loc+eello_turn3
2451 C-----------------------------------------------------------------------------
2452 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2453 C Third- and fourth-order contributions from turns
2454 implicit real*8 (a-h,o-z)
2455 include 'DIMENSIONS'
2456 include 'sizesclu.dat'
2457 include 'COMMON.IOUNITS'
2458 include 'COMMON.GEO'
2459 include 'COMMON.VAR'
2460 include 'COMMON.LOCAL'
2461 include 'COMMON.CHAIN'
2462 include 'COMMON.DERIV'
2463 include 'COMMON.INTERACT'
2464 include 'COMMON.CONTACTS'
2465 include 'COMMON.TORSION'
2466 include 'COMMON.VECTORS'
2467 include 'COMMON.FFIELD'
2469 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2470 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2471 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2472 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2473 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2474 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2476 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2478 C Third-order contributions
2485 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2486 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2487 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2488 call transpose2(auxmat(1,1),auxmat1(1,1))
2489 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2490 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2491 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2492 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2493 cd & ' eello_turn3_num',4*eello_turn3_num
2495 C Derivatives in gamma(i)
2496 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2497 call transpose2(auxmat2(1,1),pizda(1,1))
2498 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2499 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2500 C Derivatives in gamma(i+1)
2501 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2502 call transpose2(auxmat2(1,1),pizda(1,1))
2503 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2504 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2505 & +0.5d0*(pizda(1,1)+pizda(2,2))
2506 C Cartesian derivatives
2508 a_temp(1,1)=aggi(l,1)
2509 a_temp(1,2)=aggi(l,2)
2510 a_temp(2,1)=aggi(l,3)
2511 a_temp(2,2)=aggi(l,4)
2512 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2513 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2514 & +0.5d0*(pizda(1,1)+pizda(2,2))
2515 a_temp(1,1)=aggi1(l,1)
2516 a_temp(1,2)=aggi1(l,2)
2517 a_temp(2,1)=aggi1(l,3)
2518 a_temp(2,2)=aggi1(l,4)
2519 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2520 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2521 & +0.5d0*(pizda(1,1)+pizda(2,2))
2522 a_temp(1,1)=aggj(l,1)
2523 a_temp(1,2)=aggj(l,2)
2524 a_temp(2,1)=aggj(l,3)
2525 a_temp(2,2)=aggj(l,4)
2526 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2527 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2528 & +0.5d0*(pizda(1,1)+pizda(2,2))
2529 a_temp(1,1)=aggj1(l,1)
2530 a_temp(1,2)=aggj1(l,2)
2531 a_temp(2,1)=aggj1(l,3)
2532 a_temp(2,2)=aggj1(l,4)
2533 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2534 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2535 & +0.5d0*(pizda(1,1)+pizda(2,2))
2538 else if (j.eq.i+3) then
2539 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2541 C Fourth-order contributions
2549 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2550 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2551 iti1=itortyp(itype(i+1))
2552 iti2=itortyp(itype(i+2))
2553 iti3=itortyp(itype(i+3))
2554 call transpose2(EUg(1,1,i+1),e1t(1,1))
2555 call transpose2(Eug(1,1,i+2),e2t(1,1))
2556 call transpose2(Eug(1,1,i+3),e3t(1,1))
2557 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2558 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2559 s1=scalar2(b1(1,iti2),auxvec(1))
2560 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2561 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2562 s2=scalar2(b1(1,iti1),auxvec(1))
2563 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2564 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2565 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2566 eello_turn4=eello_turn4-(s1+s2+s3)
2567 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2568 cd & ' eello_turn4_num',8*eello_turn4_num
2569 C Derivatives in gamma(i)
2571 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2572 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2573 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2574 s1=scalar2(b1(1,iti2),auxvec(1))
2575 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2576 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2577 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2578 C Derivatives in gamma(i+1)
2579 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2580 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2581 s2=scalar2(b1(1,iti1),auxvec(1))
2582 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2583 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2584 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2585 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2586 C Derivatives in gamma(i+2)
2587 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2588 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2589 s1=scalar2(b1(1,iti2),auxvec(1))
2590 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2591 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2592 s2=scalar2(b1(1,iti1),auxvec(1))
2593 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2594 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2595 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2596 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2597 C Cartesian derivatives
2598 C Derivatives of this turn contributions in DC(i+2)
2599 if (j.lt.nres-1) then
2601 a_temp(1,1)=agg(l,1)
2602 a_temp(1,2)=agg(l,2)
2603 a_temp(2,1)=agg(l,3)
2604 a_temp(2,2)=agg(l,4)
2605 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2606 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2607 s1=scalar2(b1(1,iti2),auxvec(1))
2608 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2609 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2610 s2=scalar2(b1(1,iti1),auxvec(1))
2611 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2612 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2613 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2615 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2618 C Remaining derivatives of this turn contribution
2620 a_temp(1,1)=aggi(l,1)
2621 a_temp(1,2)=aggi(l,2)
2622 a_temp(2,1)=aggi(l,3)
2623 a_temp(2,2)=aggi(l,4)
2624 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2625 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2626 s1=scalar2(b1(1,iti2),auxvec(1))
2627 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2628 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2629 s2=scalar2(b1(1,iti1),auxvec(1))
2630 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2631 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2632 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2633 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2634 a_temp(1,1)=aggi1(l,1)
2635 a_temp(1,2)=aggi1(l,2)
2636 a_temp(2,1)=aggi1(l,3)
2637 a_temp(2,2)=aggi1(l,4)
2638 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2639 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2640 s1=scalar2(b1(1,iti2),auxvec(1))
2641 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2642 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2643 s2=scalar2(b1(1,iti1),auxvec(1))
2644 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2645 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2646 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2647 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2648 a_temp(1,1)=aggj(l,1)
2649 a_temp(1,2)=aggj(l,2)
2650 a_temp(2,1)=aggj(l,3)
2651 a_temp(2,2)=aggj(l,4)
2652 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2653 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2654 s1=scalar2(b1(1,iti2),auxvec(1))
2655 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2656 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2657 s2=scalar2(b1(1,iti1),auxvec(1))
2658 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2659 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2660 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2661 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2662 a_temp(1,1)=aggj1(l,1)
2663 a_temp(1,2)=aggj1(l,2)
2664 a_temp(2,1)=aggj1(l,3)
2665 a_temp(2,2)=aggj1(l,4)
2666 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2667 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2668 s1=scalar2(b1(1,iti2),auxvec(1))
2669 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2670 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2671 s2=scalar2(b1(1,iti1),auxvec(1))
2672 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2673 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2674 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2675 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2681 C-----------------------------------------------------------------------------
2682 subroutine vecpr(u,v,w)
2683 implicit real*8(a-h,o-z)
2684 dimension u(3),v(3),w(3)
2685 w(1)=u(2)*v(3)-u(3)*v(2)
2686 w(2)=-u(1)*v(3)+u(3)*v(1)
2687 w(3)=u(1)*v(2)-u(2)*v(1)
2690 C-----------------------------------------------------------------------------
2691 subroutine unormderiv(u,ugrad,unorm,ungrad)
2692 C This subroutine computes the derivatives of a normalized vector u, given
2693 C the derivatives computed without normalization conditions, ugrad. Returns
2696 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2697 double precision vec(3)
2698 double precision scalar
2700 c write (2,*) 'ugrad',ugrad
2703 vec(i)=scalar(ugrad(1,i),u(1))
2705 c write (2,*) 'vec',vec
2708 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2711 c write (2,*) 'ungrad',ungrad
2714 C-----------------------------------------------------------------------------
2715 subroutine escp(evdw2,evdw2_14)
2717 C This subroutine calculates the excluded-volume interaction energy between
2718 C peptide-group centers and side chains and its gradient in virtual-bond and
2719 C side-chain vectors.
2721 implicit real*8 (a-h,o-z)
2722 include 'DIMENSIONS'
2723 include 'sizesclu.dat'
2724 include 'COMMON.GEO'
2725 include 'COMMON.VAR'
2726 include 'COMMON.LOCAL'
2727 include 'COMMON.CHAIN'
2728 include 'COMMON.DERIV'
2729 include 'COMMON.INTERACT'
2730 include 'COMMON.FFIELD'
2731 include 'COMMON.IOUNITS'
2735 cd print '(a)','Enter ESCP'
2736 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2737 c & ' scal14',scal14
2738 do i=iatscp_s,iatscp_e
2740 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2741 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2742 if (iteli.eq.0) goto 1225
2743 xi=0.5D0*(c(1,i)+c(1,i+1))
2744 yi=0.5D0*(c(2,i)+c(2,i+1))
2745 zi=0.5D0*(c(3,i)+c(3,i+1))
2747 do iint=1,nscp_gr(i)
2749 do j=iscpstart(i,iint),iscpend(i,iint)
2751 C Uncomment following three lines for SC-p interactions
2755 C Uncomment following three lines for Ca-p interactions
2759 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2761 e1=fac*fac*aad(itypj,iteli)
2762 e2=fac*bad(itypj,iteli)
2763 if (iabs(j-i) .le. 2) then
2766 evdw2_14=evdw2_14+e1+e2
2769 c write (iout,*) i,j,evdwij
2773 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2775 fac=-(evdwij+e1)*rrij
2780 cd write (iout,*) 'j<i'
2781 C Uncomment following three lines for SC-p interactions
2783 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2786 cd write (iout,*) 'j>i'
2789 C Uncomment following line for SC-p interactions
2790 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2794 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2798 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2799 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2802 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2812 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2813 gradx_scp(j,i)=expon*gradx_scp(j,i)
2816 C******************************************************************************
2820 C To save time the factor EXPON has been extracted from ALL components
2821 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2824 C******************************************************************************
2827 C--------------------------------------------------------------------------
2828 subroutine edis(ehpb)
2830 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2832 implicit real*8 (a-h,o-z)
2833 include 'DIMENSIONS'
2834 include 'COMMON.SBRIDGE'
2835 include 'COMMON.CHAIN'
2836 include 'COMMON.DERIV'
2837 include 'COMMON.VAR'
2838 include 'COMMON.INTERACT'
2839 include 'COMMON.IOUNITS'
2842 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2843 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2844 if (link_end.eq.0) return
2845 do i=link_start,link_end
2846 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2847 C CA-CA distance used in regularization of structure.
2850 C iii and jjj point to the residues for which the distance is assigned.
2851 if (ii.gt.nres) then
2858 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2859 c & dhpb(i),dhpb1(i),forcon(i)
2860 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2861 C distance and angle dependent SS bond potential.
2862 if (.not.dyn_ss .and. i.le.nss) then
2863 C 15/02/13 CC dynamic SSbond - additional check
2864 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2865 call ssbond_ene(iii,jjj,eij)
2867 cd write (iout,*) "eij",eij
2869 else if (ii.gt.nres .and. jj.gt.nres) then
2870 c Restraints from contact prediction
2872 if (dhpb1(i).gt.0.0d0) then
2873 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2874 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2875 c write (iout,*) "beta nmr",
2876 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2880 C Get the force constant corresponding to this distance.
2882 C Calculate the contribution to energy.
2883 ehpb=ehpb+waga*rdis*rdis
2884 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2886 C Evaluate gradient.
2891 ggg(j)=fac*(c(j,jj)-c(j,ii))
2894 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2895 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)
2902 C Calculate the distance between the two points and its difference from the
2905 if (dhpb1(i).gt.0.0d0) then
2906 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2907 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2908 c write (iout,*) "alph nmr",
2909 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2912 C Get the force constant corresponding to this distance.
2914 C Calculate the contribution to energy.
2915 ehpb=ehpb+waga*rdis*rdis
2916 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2918 C Evaluate gradient.
2922 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2923 cd & ' waga=',waga,' fac=',fac
2925 ggg(j)=fac*(c(j,jj)-c(j,ii))
2927 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2928 C If this is a SC-SC distance, we need to calculate the contributions to the
2929 C Cartesian gradient in the SC vectors (ghpbx).
2932 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2933 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2937 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2938 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2945 C--------------------------------------------------------------------------
2946 subroutine ssbond_ene(i,j,eij)
2948 C Calculate the distance and angle dependent SS-bond potential energy
2949 C using a free-energy function derived based on RHF/6-31G** ab initio
2950 C calculations of diethyl disulfide.
2952 C A. Liwo and U. Kozlowska, 11/24/03
2954 implicit real*8 (a-h,o-z)
2955 include 'DIMENSIONS'
2956 include 'sizesclu.dat'
2957 include 'COMMON.SBRIDGE'
2958 include 'COMMON.CHAIN'
2959 include 'COMMON.DERIV'
2960 include 'COMMON.LOCAL'
2961 include 'COMMON.INTERACT'
2962 include 'COMMON.VAR'
2963 include 'COMMON.IOUNITS'
2964 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2969 dxi=dc_norm(1,nres+i)
2970 dyi=dc_norm(2,nres+i)
2971 dzi=dc_norm(3,nres+i)
2972 dsci_inv=dsc_inv(itypi)
2974 dscj_inv=dsc_inv(itypj)
2978 dxj=dc_norm(1,nres+j)
2979 dyj=dc_norm(2,nres+j)
2980 dzj=dc_norm(3,nres+j)
2981 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2986 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2987 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2988 om12=dxi*dxj+dyi*dyj+dzi*dzj
2990 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2991 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2997 deltat12=om2-om1+2.0d0
2999 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3000 & +akct*deltad*deltat12+ebr
3001 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3002 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3003 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3004 c & " deltat12",deltat12," eij",eij
3005 ed=2*akcm*deltad+akct*deltat12
3007 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3008 eom1=-2*akth*deltat1-pom1-om2*pom2
3009 eom2= 2*akth*deltat2+pom1-om1*pom2
3012 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3015 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3016 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3017 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3018 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3021 C Calculate the components of the gradient in DC and X
3025 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3031 C--------------------------------------------------------------------------
3034 c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
3035 subroutine e_modeller(ehomology_constr)
3036 implicit real*8 (a-h,o-z)
3038 include 'DIMENSIONS'
3040 integer nnn, i, j, k, ki, irec, l
3041 integer katy, odleglosci, test7
3042 real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
3043 real*8 distance(max_template),distancek(max_template),
3044 & min_odl,godl(max_template),dih_diff(max_template)
3046 include 'COMMON.SBRIDGE'
3047 include 'COMMON.CHAIN'
3048 include 'COMMON.GEO'
3049 include 'COMMON.DERIV'
3050 include 'COMMON.LOCAL'
3051 include 'COMMON.INTERACT'
3052 include 'COMMON.VAR'
3053 include 'COMMON.IOUNITS'
3054 include 'COMMON.CONTROL'
3058 distancek(i)=9999999.9
3063 write (iout,*) "waga_dist",waga_dist
3064 c Pseudo-energy and gradient from homology restraints (MODELLER-like
3066 C AL 5/2/14 - Introduce list of restraints
3067 do ii = link_start_homo,link_end_homo
3071 do k=1,constr_homology
3072 distance(k)=odl(k,ii)-dij
3073 distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii)
3076 min_odl=minval(distancek)
3078 write (iout,*) "ij dij",i,j,dij
3079 write (iout,*) "distance",(distance(k),k=1,constr_homology)
3080 write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
3081 write (iout,* )"min_odl",min_odl
3084 do k=1,constr_homology
3085 c Nie wiem po co to liczycie jeszcze raz!
3086 c odleg3=-waga_dist*((distance(i,j,k)**2)/
3087 c & (2*(sigma_odl(i,j,k))**2))
3088 godl(k)=dexp(-distancek(k)+min_odl)
3089 odleg2=odleg2+godl(k)
3091 ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
3092 ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
3093 ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
3094 ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
3098 write (iout,*) "godl",(godl(k),k=1,constr_homology)
3099 write (iout,*) "ii i j",ii,i,j," odleg2",odleg2
3101 odleg=odleg-dLOG(odleg2/constr_homology)+min_odl
3105 do k=1,constr_homology
3106 c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3107 c & *waga_dist)+min_odl
3108 sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
3109 sum_sgodl=sum_sgodl+sgodl
3111 c sgodl2=sgodl2+sgodl
3112 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
3113 c write(iout,*) "constr_homology=",constr_homology
3114 c write(iout,*) i, j, k, "TEST K"
3117 grad_odl3=sum_sgodl/(sum_godl*dij)
3120 c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
3121 c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
3122 c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
3124 ccc write(iout,*) godl, sgodl, grad_odl3
3126 c grad_odl=grad_odl+grad_odl3
3129 ggodl=grad_odl3*(c(jik,i)-c(jik,j))
3130 ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
3131 ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
3132 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3133 ghpbc(jik,i)=ghpbc(jik,i)+ggodl
3134 ghpbc(jik,j)=ghpbc(jik,j)-ggodl
3135 ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
3136 ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
3139 ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
3140 ccc & dLOG(odleg2),"-odleg=", -odleg
3143 c Pseudo-energy and gradient from dihedral-angle restraints from
3144 c homology templates
3145 c write (iout,*) "End of distance loop"
3148 c write (iout,*) idihconstr_start_homo,idihconstr_end_homo
3149 do i=idihconstr_start_homo,idihconstr_end_homo
3151 c betai=beta(i,i+1,i+2,i+3)
3153 do k=1,constr_homology
3154 dih_diff(k)=pinorm(dih(k,i)-betai)
3155 c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
3156 c & -(6.28318-dih_diff(i,k))
3157 c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
3158 c & 6.28318+dih_diff(i,k)
3160 kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
3163 c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
3167 write (iout,*) "i",i," betai",betai," kat2",kat2
3168 write (iout,*) "gdih",(gdih(k),k=1,constr_homology)
3170 if (kat2.le.1.0d-14) cycle
3171 kat=kat-dLOG(kat2/constr_homology)
3173 ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
3174 ccc & dLOG(kat2), "-kat=", -kat
3176 c ----------------------------------------------------------------------
3178 c ----------------------------------------------------------------------
3182 do k=1,constr_homology
3183 sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
3184 sum_sgdih=sum_sgdih+sgdih
3186 grad_dih3=sum_sgdih/sum_gdih
3188 c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
3189 ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
3190 ccc & gloc(nphi+i-3,icg)
3191 gloc(i,icg)=gloc(i,icg)+grad_dih3
3192 ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
3193 ccc & gloc(nphi+i-3,icg)
3198 c Total energy from homology restraints
3200 write (iout,*) "odleg",odleg," kat",kat
3202 ehomology_constr=odleg+kat
3205 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
3206 747 format(a12,i4,i4,i4,f8.3,f8.3)
3207 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
3208 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
3209 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
3210 & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
3216 C--------------------------------------------------------------------------
3217 subroutine ebond(estr)
3219 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3221 implicit real*8 (a-h,o-z)
3222 include 'DIMENSIONS'
3223 include 'COMMON.LOCAL'
3224 include 'COMMON.GEO'
3225 include 'COMMON.INTERACT'
3226 include 'COMMON.DERIV'
3227 include 'COMMON.VAR'
3228 include 'COMMON.CHAIN'
3229 include 'COMMON.IOUNITS'
3230 include 'COMMON.NAMES'
3231 include 'COMMON.FFIELD'
3232 include 'COMMON.CONTROL'
3233 double precision u(3),ud(3)
3236 diff = vbld(i)-vbldp0
3237 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3240 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3245 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3252 diff=vbld(i+nres)-vbldsc0(1,iti)
3253 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3254 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3255 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3257 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3261 diff=vbld(i+nres)-vbldsc0(j,iti)
3262 ud(j)=aksc(j,iti)*diff
3263 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3277 uprod2=uprod2*u(k)*u(k)
3281 usumsqder=usumsqder+ud(j)*uprod2
3283 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3284 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3285 estr=estr+uprod/usum
3287 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3295 C--------------------------------------------------------------------------
3296 subroutine ebend(etheta)
3298 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3299 C angles gamma and its derivatives in consecutive thetas and gammas.
3301 implicit real*8 (a-h,o-z)
3302 include 'DIMENSIONS'
3303 include 'sizesclu.dat'
3304 include 'COMMON.LOCAL'
3305 include 'COMMON.GEO'
3306 include 'COMMON.INTERACT'
3307 include 'COMMON.DERIV'
3308 include 'COMMON.VAR'
3309 include 'COMMON.CHAIN'
3310 include 'COMMON.IOUNITS'
3311 include 'COMMON.NAMES'
3312 include 'COMMON.FFIELD'
3313 common /calcthet/ term1,term2,termm,diffak,ratak,
3314 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3315 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3316 double precision y(2),z(2)
3318 time11=dexp(-2*time)
3321 c write (iout,*) "nres",nres
3322 c write (*,'(a,i2)') 'EBEND ICG=',icg
3323 c write (iout,*) ithet_start,ithet_end
3324 do i=ithet_start,ithet_end
3325 C Zero the energy function and its derivative at 0 or pi.
3326 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3328 c if (i.gt.ithet_start .and.
3329 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3330 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3338 c if (i.lt.nres .and. itel(i).ne.0) then
3350 call proc_proc(phii,icrc)
3351 if (icrc.eq.1) phii=150.0
3365 call proc_proc(phii1,icrc)
3366 if (icrc.eq.1) phii1=150.0
3378 C Calculate the "mean" value of theta from the part of the distribution
3379 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3380 C In following comments this theta will be referred to as t_c.
3381 thet_pred_mean=0.0d0
3385 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3387 c write (iout,*) "thet_pred_mean",thet_pred_mean
3388 dthett=thet_pred_mean*ssd
3389 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3390 c write (iout,*) "thet_pred_mean",thet_pred_mean
3391 C Derivatives of the "mean" values in gamma1 and gamma2.
3392 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3393 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3394 if (theta(i).gt.pi-delta) then
3395 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3397 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3398 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3399 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3401 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3403 else if (theta(i).lt.delta) then
3404 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3405 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3406 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3408 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3409 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3412 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3415 etheta=etheta+ethetai
3416 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3417 c & rad2deg*phii,rad2deg*phii1,ethetai
3418 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3419 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3420 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3423 C Ufff.... We've done all this!!!
3426 C---------------------------------------------------------------------------
3427 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3429 implicit real*8 (a-h,o-z)
3430 include 'DIMENSIONS'
3431 include 'COMMON.LOCAL'
3432 include 'COMMON.IOUNITS'
3433 common /calcthet/ term1,term2,termm,diffak,ratak,
3434 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3435 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3436 C Calculate the contributions to both Gaussian lobes.
3437 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3438 C The "polynomial part" of the "standard deviation" of this part of
3442 sig=sig*thet_pred_mean+polthet(j,it)
3444 C Derivative of the "interior part" of the "standard deviation of the"
3445 C gamma-dependent Gaussian lobe in t_c.
3446 sigtc=3*polthet(3,it)
3448 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3451 C Set the parameters of both Gaussian lobes of the distribution.
3452 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3453 fac=sig*sig+sigc0(it)
3456 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3457 sigsqtc=-4.0D0*sigcsq*sigtc
3458 c print *,i,sig,sigtc,sigsqtc
3459 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3460 sigtc=-sigtc/(fac*fac)
3461 C Following variable is sigma(t_c)**(-2)
3462 sigcsq=sigcsq*sigcsq
3464 sig0inv=1.0D0/sig0i**2
3465 delthec=thetai-thet_pred_mean
3466 delthe0=thetai-theta0i
3467 term1=-0.5D0*sigcsq*delthec*delthec
3468 term2=-0.5D0*sig0inv*delthe0*delthe0
3469 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3470 C NaNs in taking the logarithm. We extract the largest exponent which is added
3471 C to the energy (this being the log of the distribution) at the end of energy
3472 C term evaluation for this virtual-bond angle.
3473 if (term1.gt.term2) then
3475 term2=dexp(term2-termm)
3479 term1=dexp(term1-termm)
3482 C The ratio between the gamma-independent and gamma-dependent lobes of
3483 C the distribution is a Gaussian function of thet_pred_mean too.
3484 diffak=gthet(2,it)-thet_pred_mean
3485 ratak=diffak/gthet(3,it)**2
3486 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3487 C Let's differentiate it in thet_pred_mean NOW.
3489 C Now put together the distribution terms to make complete distribution.
3490 termexp=term1+ak*term2
3491 termpre=sigc+ak*sig0i
3492 C Contribution of the bending energy from this theta is just the -log of
3493 C the sum of the contributions from the two lobes and the pre-exponential
3494 C factor. Simple enough, isn't it?
3495 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3496 C NOW the derivatives!!!
3497 C 6/6/97 Take into account the deformation.
3498 E_theta=(delthec*sigcsq*term1
3499 & +ak*delthe0*sig0inv*term2)/termexp
3500 E_tc=((sigtc+aktc*sig0i)/termpre
3501 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3502 & aktc*term2)/termexp)
3505 c-----------------------------------------------------------------------------
3506 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3507 implicit real*8 (a-h,o-z)
3508 include 'DIMENSIONS'
3509 include 'COMMON.LOCAL'
3510 include 'COMMON.IOUNITS'
3511 common /calcthet/ term1,term2,termm,diffak,ratak,
3512 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3513 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3514 delthec=thetai-thet_pred_mean
3515 delthe0=thetai-theta0i
3516 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3517 t3 = thetai-thet_pred_mean
3521 t14 = t12+t6*sigsqtc
3523 t21 = thetai-theta0i
3529 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3530 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3531 & *(-t12*t9-ak*sig0inv*t27)
3535 C--------------------------------------------------------------------------
3536 subroutine ebend(etheta)
3538 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3539 C angles gamma and its derivatives in consecutive thetas and gammas.
3540 C ab initio-derived potentials from
3541 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3543 implicit real*8 (a-h,o-z)
3544 include 'DIMENSIONS'
3545 include 'COMMON.LOCAL'
3546 include 'COMMON.GEO'
3547 include 'COMMON.INTERACT'
3548 include 'COMMON.DERIV'
3549 include 'COMMON.VAR'
3550 include 'COMMON.CHAIN'
3551 include 'COMMON.IOUNITS'
3552 include 'COMMON.NAMES'
3553 include 'COMMON.FFIELD'
3554 include 'COMMON.CONTROL'
3555 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3556 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3557 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3558 & sinph1ph2(maxdouble,maxdouble)
3559 logical lprn /.false./, lprn1 /.false./
3561 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3562 do i=ithet_start,ithet_end
3566 theti2=0.5d0*theta(i)
3567 ityp2=ithetyp(itype(i-1))
3569 coskt(k)=dcos(k*theti2)
3570 sinkt(k)=dsin(k*theti2)
3575 if (phii.ne.phii) phii=150.0
3579 ityp1=ithetyp(itype(i-2))
3581 cosph1(k)=dcos(k*phii)
3582 sinph1(k)=dsin(k*phii)
3595 if (phii1.ne.phii1) phii1=150.0
3600 ityp3=ithetyp(itype(i))
3602 cosph2(k)=dcos(k*phii1)
3603 sinph2(k)=dsin(k*phii1)
3613 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3614 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3616 ethetai=aa0thet(ityp1,ityp2,ityp3)
3619 ccl=cosph1(l)*cosph2(k-l)
3620 ssl=sinph1(l)*sinph2(k-l)
3621 scl=sinph1(l)*cosph2(k-l)
3622 csl=cosph1(l)*sinph2(k-l)
3623 cosph1ph2(l,k)=ccl-ssl
3624 cosph1ph2(k,l)=ccl+ssl
3625 sinph1ph2(l,k)=scl+csl
3626 sinph1ph2(k,l)=scl-csl
3630 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3631 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3632 write (iout,*) "coskt and sinkt"
3634 write (iout,*) k,coskt(k),sinkt(k)
3638 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3639 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3642 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3643 & " ethetai",ethetai
3646 write (iout,*) "cosph and sinph"
3648 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3650 write (iout,*) "cosph1ph2 and sinph2ph2"
3653 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3654 & sinph1ph2(l,k),sinph1ph2(k,l)
3657 write(iout,*) "ethetai",ethetai
3661 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3662 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3663 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3664 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3665 ethetai=ethetai+sinkt(m)*aux
3666 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3667 dephii=dephii+k*sinkt(m)*(
3668 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3669 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3670 dephii1=dephii1+k*sinkt(m)*(
3671 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3672 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3674 & write (iout,*) "m",m," k",k," bbthet",
3675 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3676 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3677 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3678 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3682 & write(iout,*) "ethetai",ethetai
3686 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3687 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3688 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3689 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3690 ethetai=ethetai+sinkt(m)*aux
3691 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3692 dephii=dephii+l*sinkt(m)*(
3693 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3694 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3695 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3696 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3697 dephii1=dephii1+(k-l)*sinkt(m)*(
3698 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3699 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3700 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3701 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3703 write (iout,*) "m",m," k",k," l",l," ffthet",
3704 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3705 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3706 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3707 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3708 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3709 & cosph1ph2(k,l)*sinkt(m),
3710 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3716 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3717 & i,theta(i)*rad2deg,phii*rad2deg,
3718 & phii1*rad2deg,ethetai
3719 etheta=etheta+ethetai
3720 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3721 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3722 gloc(nphi+i-2,icg)=wang*dethetai
3728 c-----------------------------------------------------------------------------
3729 subroutine esc(escloc)
3730 C Calculate the local energy of a side chain and its derivatives in the
3731 C corresponding virtual-bond valence angles THETA and the spherical angles
3733 implicit real*8 (a-h,o-z)
3734 include 'DIMENSIONS'
3735 include 'sizesclu.dat'
3736 include 'COMMON.GEO'
3737 include 'COMMON.LOCAL'
3738 include 'COMMON.VAR'
3739 include 'COMMON.INTERACT'
3740 include 'COMMON.DERIV'
3741 include 'COMMON.CHAIN'
3742 include 'COMMON.IOUNITS'
3743 include 'COMMON.NAMES'
3744 include 'COMMON.FFIELD'
3745 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3746 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3747 common /sccalc/ time11,time12,time112,theti,it,nlobit
3750 c write (iout,'(a)') 'ESC'
3751 do i=loc_start,loc_end
3753 if (it.eq.10) goto 1
3755 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3756 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3757 theti=theta(i+1)-pipol
3761 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3763 if (x(2).gt.pi-delta) then
3767 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3769 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3770 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3772 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3773 & ddersc0(1),dersc(1))
3774 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3775 & ddersc0(3),dersc(3))
3777 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3779 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3780 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3781 & dersc0(2),esclocbi,dersc02)
3782 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3784 call splinthet(x(2),0.5d0*delta,ss,ssd)
3789 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3791 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3792 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3794 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3796 c write (iout,*) escloci
3797 else if (x(2).lt.delta) then
3801 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3803 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3804 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3806 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3807 & ddersc0(1),dersc(1))
3808 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3809 & ddersc0(3),dersc(3))
3811 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3813 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3814 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3815 & dersc0(2),esclocbi,dersc02)
3816 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3821 call splinthet(x(2),0.5d0*delta,ss,ssd)
3823 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3825 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3826 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3828 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3829 c write (iout,*) escloci
3831 call enesc(x,escloci,dersc,ddummy,.false.)
3834 escloc=escloc+escloci
3835 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3837 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3839 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3840 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3845 C---------------------------------------------------------------------------
3846 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3847 implicit real*8 (a-h,o-z)
3848 include 'DIMENSIONS'
3849 include 'COMMON.GEO'
3850 include 'COMMON.LOCAL'
3851 include 'COMMON.IOUNITS'
3852 common /sccalc/ time11,time12,time112,theti,it,nlobit
3853 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3854 double precision contr(maxlob,-1:1)
3856 c write (iout,*) 'it=',it,' nlobit=',nlobit
3860 if (mixed) ddersc(j)=0.0d0
3864 C Because of periodicity of the dependence of the SC energy in omega we have
3865 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3866 C To avoid underflows, first compute & store the exponents.
3874 z(k)=x(k)-censc(k,j,it)
3879 Axk=Axk+gaussc(l,k,j,it)*z(l)
3885 expfac=expfac+Ax(k,j,iii)*z(k)
3893 C As in the case of ebend, we want to avoid underflows in exponentiation and
3894 C subsequent NaNs and INFs in energy calculation.
3895 C Find the largest exponent
3899 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3903 cd print *,'it=',it,' emin=',emin
3905 C Compute the contribution to SC energy and derivatives
3909 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3910 cd print *,'j=',j,' expfac=',expfac
3911 escloc_i=escloc_i+expfac
3913 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3917 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3918 & +gaussc(k,2,j,it))*expfac
3925 dersc(1)=dersc(1)/cos(theti)**2
3926 ddersc(1)=ddersc(1)/cos(theti)**2
3929 escloci=-(dlog(escloc_i)-emin)
3931 dersc(j)=dersc(j)/escloc_i
3935 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3940 C------------------------------------------------------------------------------
3941 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3942 implicit real*8 (a-h,o-z)
3943 include 'DIMENSIONS'
3944 include 'COMMON.GEO'
3945 include 'COMMON.LOCAL'
3946 include 'COMMON.IOUNITS'
3947 common /sccalc/ time11,time12,time112,theti,it,nlobit
3948 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3949 double precision contr(maxlob)
3960 z(k)=x(k)-censc(k,j,it)
3966 Axk=Axk+gaussc(l,k,j,it)*z(l)
3972 expfac=expfac+Ax(k,j)*z(k)
3977 C As in the case of ebend, we want to avoid underflows in exponentiation and
3978 C subsequent NaNs and INFs in energy calculation.
3979 C Find the largest exponent
3982 if (emin.gt.contr(j)) emin=contr(j)
3986 C Compute the contribution to SC energy and derivatives
3990 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3991 escloc_i=escloc_i+expfac
3993 dersc(k)=dersc(k)+Ax(k,j)*expfac
3995 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3996 & +gaussc(1,2,j,it))*expfac
4000 dersc(1)=dersc(1)/cos(theti)**2
4001 dersc12=dersc12/cos(theti)**2
4002 escloci=-(dlog(escloc_i)-emin)
4004 dersc(j)=dersc(j)/escloc_i
4006 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4010 c----------------------------------------------------------------------------------
4011 subroutine esc(escloc)
4012 C Calculate the local energy of a side chain and its derivatives in the
4013 C corresponding virtual-bond valence angles THETA and the spherical angles
4014 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4015 C added by Urszula Kozlowska. 07/11/2007
4017 implicit real*8 (a-h,o-z)
4018 include 'DIMENSIONS'
4019 include 'COMMON.GEO'
4020 include 'COMMON.LOCAL'
4021 include 'COMMON.VAR'
4022 include 'COMMON.SCROT'
4023 include 'COMMON.INTERACT'
4024 include 'COMMON.DERIV'
4025 include 'COMMON.CHAIN'
4026 include 'COMMON.IOUNITS'
4027 include 'COMMON.NAMES'
4028 include 'COMMON.FFIELD'
4029 include 'COMMON.CONTROL'
4030 include 'COMMON.VECTORS'
4031 double precision x_prime(3),y_prime(3),z_prime(3)
4032 & , sumene,dsc_i,dp2_i,x(65),
4033 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4034 & de_dxx,de_dyy,de_dzz,de_dt
4035 double precision s1_t,s1_6_t,s2_t,s2_6_t
4037 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4038 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4039 & dt_dCi(3),dt_dCi1(3)
4040 common /sccalc/ time11,time12,time112,theti,it,nlobit
4043 do i=loc_start,loc_end
4044 costtab(i+1) =dcos(theta(i+1))
4045 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4046 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4047 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4048 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4049 cosfac=dsqrt(cosfac2)
4050 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4051 sinfac=dsqrt(sinfac2)
4053 if (it.eq.10) goto 1
4055 C Compute the axes of tghe local cartesian coordinates system; store in
4056 c x_prime, y_prime and z_prime
4063 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4064 C & dc_norm(3,i+nres)
4066 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4067 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4070 z_prime(j) = -uz(j,i-1)
4073 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4074 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4075 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4076 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4077 c & " xy",scalar(x_prime(1),y_prime(1)),
4078 c & " xz",scalar(x_prime(1),z_prime(1)),
4079 c & " yy",scalar(y_prime(1),y_prime(1)),
4080 c & " yz",scalar(y_prime(1),z_prime(1)),
4081 c & " zz",scalar(z_prime(1),z_prime(1))
4083 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4084 C to local coordinate system. Store in xx, yy, zz.
4090 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4091 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4092 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4099 C Compute the energy of the ith side cbain
4101 c write (2,*) "xx",xx," yy",yy," zz",zz
4104 x(j) = sc_parmin(j,it)
4107 Cc diagnostics - remove later
4109 yy1 = dsin(alph(2))*dcos(omeg(2))
4110 zz1 = -dsin(alph(2))*dsin(omeg(2))
4111 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4112 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4114 C," --- ", xx_w,yy_w,zz_w
4117 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4118 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4120 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4121 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4123 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4124 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4125 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4126 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4127 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4129 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4130 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4131 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4132 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4133 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4135 dsc_i = 0.743d0+x(61)
4137 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4138 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4139 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4140 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4141 s1=(1+x(63))/(0.1d0 + dscp1)
4142 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4143 s2=(1+x(65))/(0.1d0 + dscp2)
4144 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4145 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4146 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4147 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4149 c & dscp1,dscp2,sumene
4150 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4151 escloc = escloc + sumene
4152 c write (2,*) "escloc",escloc
4153 if (.not. calc_grad) goto 1
4156 C This section to check the numerical derivatives of the energy of ith side
4157 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4158 C #define DEBUG in the code to turn it on.
4160 write (2,*) "sumene =",sumene
4164 write (2,*) xx,yy,zz
4165 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4166 de_dxx_num=(sumenep-sumene)/aincr
4168 write (2,*) "xx+ sumene from enesc=",sumenep
4171 write (2,*) xx,yy,zz
4172 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4173 de_dyy_num=(sumenep-sumene)/aincr
4175 write (2,*) "yy+ sumene from enesc=",sumenep
4178 write (2,*) xx,yy,zz
4179 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4180 de_dzz_num=(sumenep-sumene)/aincr
4182 write (2,*) "zz+ sumene from enesc=",sumenep
4183 costsave=cost2tab(i+1)
4184 sintsave=sint2tab(i+1)
4185 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4186 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4187 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4188 de_dt_num=(sumenep-sumene)/aincr
4189 write (2,*) " t+ sumene from enesc=",sumenep
4190 cost2tab(i+1)=costsave
4191 sint2tab(i+1)=sintsave
4192 C End of diagnostics section.
4195 C Compute the gradient of esc
4197 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4198 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4199 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4200 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4201 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4202 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4203 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4204 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4205 pom1=(sumene3*sint2tab(i+1)+sumene1)
4206 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4207 pom2=(sumene4*cost2tab(i+1)+sumene2)
4208 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4209 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4210 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4211 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4213 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4214 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4215 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4217 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4218 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4219 & +(pom1+pom2)*pom_dx
4221 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4224 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4225 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4226 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4228 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4229 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4230 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4231 & +x(59)*zz**2 +x(60)*xx*zz
4232 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4233 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4234 & +(pom1-pom2)*pom_dy
4236 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4239 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4240 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4241 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4242 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4243 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4244 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4245 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4246 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4248 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4251 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4252 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4253 & +pom1*pom_dt1+pom2*pom_dt2
4255 write(2,*), "de_dt = ", de_dt,de_dt_num
4259 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4260 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4261 cosfac2xx=cosfac2*xx
4262 sinfac2yy=sinfac2*yy
4264 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4266 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4268 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4269 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4270 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4271 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4272 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4273 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4274 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4275 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4276 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4277 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4281 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4282 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4285 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4286 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4287 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4289 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4290 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4294 dXX_Ctab(k,i)=dXX_Ci(k)
4295 dXX_C1tab(k,i)=dXX_Ci1(k)
4296 dYY_Ctab(k,i)=dYY_Ci(k)
4297 dYY_C1tab(k,i)=dYY_Ci1(k)
4298 dZZ_Ctab(k,i)=dZZ_Ci(k)
4299 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4300 dXX_XYZtab(k,i)=dXX_XYZ(k)
4301 dYY_XYZtab(k,i)=dYY_XYZ(k)
4302 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4306 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4307 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4308 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4309 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4310 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4312 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4313 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4314 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4315 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4316 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4317 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4318 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4319 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4321 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4322 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4324 C to check gradient call subroutine check_grad
4331 c------------------------------------------------------------------------------
4332 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4334 C This procedure calculates two-body contact function g(rij) and its derivative:
4337 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4340 C where x=(rij-r0ij)/delta
4342 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4345 double precision rij,r0ij,eps0ij,fcont,fprimcont
4346 double precision x,x2,x4,delta
4350 if (x.lt.-1.0D0) then
4353 else if (x.le.1.0D0) then
4356 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4357 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4364 c------------------------------------------------------------------------------
4365 subroutine splinthet(theti,delta,ss,ssder)
4366 implicit real*8 (a-h,o-z)
4367 include 'DIMENSIONS'
4368 include 'sizesclu.dat'
4369 include 'COMMON.VAR'
4370 include 'COMMON.GEO'
4373 if (theti.gt.pipol) then
4374 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4376 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4381 c------------------------------------------------------------------------------
4382 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4384 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4385 double precision ksi,ksi2,ksi3,a1,a2,a3
4386 a1=fprim0*delta/(f1-f0)
4392 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4393 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4396 c------------------------------------------------------------------------------
4397 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4399 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4400 double precision ksi,ksi2,ksi3,a1,a2,a3
4405 a2=3*(f1x-f0x)-2*fprim0x*delta
4406 a3=fprim0x*delta-2*(f1x-f0x)
4407 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4410 C-----------------------------------------------------------------------------
4412 C-----------------------------------------------------------------------------
4413 subroutine etor(etors,edihcnstr,fact)
4414 implicit real*8 (a-h,o-z)
4415 include 'DIMENSIONS'
4416 include 'sizesclu.dat'
4417 include 'COMMON.VAR'
4418 include 'COMMON.GEO'
4419 include 'COMMON.LOCAL'
4420 include 'COMMON.TORSION'
4421 include 'COMMON.INTERACT'
4422 include 'COMMON.DERIV'
4423 include 'COMMON.CHAIN'
4424 include 'COMMON.NAMES'
4425 include 'COMMON.IOUNITS'
4426 include 'COMMON.FFIELD'
4427 include 'COMMON.TORCNSTR'
4429 C Set lprn=.true. for debugging
4433 do i=iphi_start,iphi_end
4434 itori=itortyp(itype(i-2))
4435 itori1=itortyp(itype(i-1))
4438 C Proline-Proline pair is a special case...
4439 if (itori.eq.3 .and. itori1.eq.3) then
4440 if (phii.gt.-dwapi3) then
4442 fac=1.0D0/(1.0D0-cosphi)
4443 etorsi=v1(1,3,3)*fac
4444 etorsi=etorsi+etorsi
4445 etors=etors+etorsi-v1(1,3,3)
4446 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4449 v1ij=v1(j+1,itori,itori1)
4450 v2ij=v2(j+1,itori,itori1)
4453 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4454 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4458 v1ij=v1(j,itori,itori1)
4459 v2ij=v2(j,itori,itori1)
4462 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4463 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4467 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4468 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4469 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4470 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4471 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4473 ! 6/20/98 - dihedral angle constraints
4476 itori=idih_constr(i)
4478 difi=pinorm(phii-phi0(i))
4479 if (difi.gt.drange(i)) then
4481 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4482 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4483 else if (difi.lt.-drange(i)) then
4485 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4486 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4488 c write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4489 c & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4491 write (iout,*) 'edihcnstr',edihcnstr
4494 c------------------------------------------------------------------------------
4496 subroutine etor(etors,edihcnstr,fact)
4497 implicit real*8 (a-h,o-z)
4498 include 'DIMENSIONS'
4499 include 'sizesclu.dat'
4500 include 'COMMON.VAR'
4501 include 'COMMON.GEO'
4502 include 'COMMON.LOCAL'
4503 include 'COMMON.TORSION'
4504 include 'COMMON.INTERACT'
4505 include 'COMMON.DERIV'
4506 include 'COMMON.CHAIN'
4507 include 'COMMON.NAMES'
4508 include 'COMMON.IOUNITS'
4509 include 'COMMON.FFIELD'
4510 include 'COMMON.TORCNSTR'
4512 C Set lprn=.true. for debugging
4516 do i=iphi_start,iphi_end
4517 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4518 itori=itortyp(itype(i-2))
4519 itori1=itortyp(itype(i-1))
4522 C Regular cosine and sine terms
4523 do j=1,nterm(itori,itori1)
4524 v1ij=v1(j,itori,itori1)
4525 v2ij=v2(j,itori,itori1)
4528 etors=etors+v1ij*cosphi+v2ij*sinphi
4529 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4533 C E = SUM ----------------------------------- - v1
4534 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4536 cosphi=dcos(0.5d0*phii)
4537 sinphi=dsin(0.5d0*phii)
4538 do j=1,nlor(itori,itori1)
4539 vl1ij=vlor1(j,itori,itori1)
4540 vl2ij=vlor2(j,itori,itori1)
4541 vl3ij=vlor3(j,itori,itori1)
4542 pom=vl2ij*cosphi+vl3ij*sinphi
4543 pom1=1.0d0/(pom*pom+1.0d0)
4544 etors=etors+vl1ij*pom1
4546 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4548 C Subtract the constant term
4549 etors=etors-v0(itori,itori1)
4551 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4552 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4553 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4554 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4555 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4558 ! 6/20/98 - dihedral angle constraints
4560 c write (iout,*) "Dihedral angle restraint energy"
4562 itori=idih_constr(i)
4564 difi=pinorm(phii-phi0(i))
4565 c write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
4566 c & rad2deg*difi,rad2deg*phi0(i),rad2deg*drange(i)
4567 if (difi.gt.drange(i)) then
4569 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4570 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4571 c write (iout,*) 0.25d0*ftors*difi**4
4572 else if (difi.lt.-drange(i)) then
4574 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4575 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4576 c write (iout,*) 0.25d0*ftors*difi**4
4579 c write (iout,*) 'edihcnstr',edihcnstr
4582 c----------------------------------------------------------------------------
4583 subroutine etor_d(etors_d,fact2)
4584 C 6/23/01 Compute double torsional energy
4585 implicit real*8 (a-h,o-z)
4586 include 'DIMENSIONS'
4587 include 'sizesclu.dat'
4588 include 'COMMON.VAR'
4589 include 'COMMON.GEO'
4590 include 'COMMON.LOCAL'
4591 include 'COMMON.TORSION'
4592 include 'COMMON.INTERACT'
4593 include 'COMMON.DERIV'
4594 include 'COMMON.CHAIN'
4595 include 'COMMON.NAMES'
4596 include 'COMMON.IOUNITS'
4597 include 'COMMON.FFIELD'
4598 include 'COMMON.TORCNSTR'
4600 C Set lprn=.true. for debugging
4604 do i=iphi_start,iphi_end-1
4605 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4607 itori=itortyp(itype(i-2))
4608 itori1=itortyp(itype(i-1))
4609 itori2=itortyp(itype(i))
4614 C Regular cosine and sine terms
4615 do j=1,ntermd_1(itori,itori1,itori2)
4616 v1cij=v1c(1,j,itori,itori1,itori2)
4617 v1sij=v1s(1,j,itori,itori1,itori2)
4618 v2cij=v1c(2,j,itori,itori1,itori2)
4619 v2sij=v1s(2,j,itori,itori1,itori2)
4620 cosphi1=dcos(j*phii)
4621 sinphi1=dsin(j*phii)
4622 cosphi2=dcos(j*phii1)
4623 sinphi2=dsin(j*phii1)
4624 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4625 & v2cij*cosphi2+v2sij*sinphi2
4626 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4627 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4629 do k=2,ntermd_2(itori,itori1,itori2)
4631 v1cdij = v2c(k,l,itori,itori1,itori2)
4632 v2cdij = v2c(l,k,itori,itori1,itori2)
4633 v1sdij = v2s(k,l,itori,itori1,itori2)
4634 v2sdij = v2s(l,k,itori,itori1,itori2)
4635 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4636 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4637 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4638 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4639 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4640 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4641 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4642 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4643 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4644 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4647 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4648 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4654 c------------------------------------------------------------------------------
4655 subroutine eback_sc_corr(esccor,fact)
4656 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4657 c conformational states; temporarily implemented as differences
4658 c between UNRES torsional potentials (dependent on three types of
4659 c residues) and the torsional potentials dependent on all 20 types
4660 c of residues computed from AM1 energy surfaces of terminally-blocked
4661 c amino-acid residues.
4662 implicit real*8 (a-h,o-z)
4663 include 'DIMENSIONS'
4664 include 'COMMON.VAR'
4665 include 'COMMON.GEO'
4666 include 'COMMON.LOCAL'
4667 include 'COMMON.TORSION'
4668 include 'COMMON.SCCOR'
4669 include 'COMMON.INTERACT'
4670 include 'COMMON.DERIV'
4671 include 'COMMON.CHAIN'
4672 include 'COMMON.NAMES'
4673 include 'COMMON.IOUNITS'
4674 include 'COMMON.FFIELD'
4675 include 'COMMON.CONTROL'
4677 C Set lprn=.true. for debugging
4680 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4682 do i=itau_start,itau_end
4684 isccori=isccortyp(itype(i-2))
4685 isccori1=isccortyp(itype(i-1))
4687 cccc Added 9 May 2012
4688 cc Tauangle is torsional engle depending on the value of first digit
4689 c(see comment below)
4690 cc Omicron is flat angle depending on the value of first digit
4691 c(see comment below)
4694 do intertyp=1,3 !intertyp
4695 cc Added 09 May 2012 (Adasko)
4696 cc Intertyp means interaction type of backbone mainchain correlation:
4697 c 1 = SC...Ca...Ca...Ca
4698 c 2 = Ca...Ca...Ca...SC
4699 c 3 = SC...Ca...Ca...SCi
4701 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4702 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4703 & (itype(i-1).eq.21)))
4704 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4705 & .or.(itype(i-2).eq.21)))
4706 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4707 & (itype(i-1).eq.21)))) cycle
4708 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4709 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4711 do j=1,nterm_sccor(isccori,isccori1)
4712 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4713 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4714 cosphi=dcos(j*tauangle(intertyp,i))
4715 sinphi=dsin(j*tauangle(intertyp,i))
4716 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4717 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4719 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4720 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4721 c &gloc_sc(intertyp,i-3,icg)
4723 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4724 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4725 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4726 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4727 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4733 c------------------------------------------------------------------------------
4734 subroutine multibody(ecorr)
4735 C This subroutine calculates multi-body contributions to energy following
4736 C the idea of Skolnick et al. If side chains I and J make a contact and
4737 C at the same time side chains I+1 and J+1 make a contact, an extra
4738 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4739 implicit real*8 (a-h,o-z)
4740 include 'DIMENSIONS'
4741 include 'COMMON.IOUNITS'
4742 include 'COMMON.DERIV'
4743 include 'COMMON.INTERACT'
4744 include 'COMMON.CONTACTS'
4745 double precision gx(3),gx1(3)
4748 C Set lprn=.true. for debugging
4752 write (iout,'(a)') 'Contact function values:'
4754 write (iout,'(i2,20(1x,i2,f10.5))')
4755 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4770 num_conti=num_cont(i)
4771 num_conti1=num_cont(i1)
4776 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4777 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4778 cd & ' ishift=',ishift
4779 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4780 C The system gains extra energy.
4781 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4782 endif ! j1==j+-ishift
4791 c------------------------------------------------------------------------------
4792 double precision function esccorr(i,j,k,l,jj,kk)
4793 implicit real*8 (a-h,o-z)
4794 include 'DIMENSIONS'
4795 include 'COMMON.IOUNITS'
4796 include 'COMMON.DERIV'
4797 include 'COMMON.INTERACT'
4798 include 'COMMON.CONTACTS'
4799 double precision gx(3),gx1(3)
4804 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4805 C Calculate the multi-body contribution to energy.
4806 C Calculate multi-body contributions to the gradient.
4807 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4808 cd & k,l,(gacont(m,kk,k),m=1,3)
4810 gx(m) =ekl*gacont(m,jj,i)
4811 gx1(m)=eij*gacont(m,kk,k)
4812 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4813 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4814 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4815 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4819 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4824 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4830 c------------------------------------------------------------------------------
4832 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4833 implicit real*8 (a-h,o-z)
4834 include 'DIMENSIONS'
4835 integer dimen1,dimen2,atom,indx
4836 double precision buffer(dimen1,dimen2)
4837 double precision zapas
4838 common /contacts_hb/ zapas(3,20,maxres,7),
4839 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4840 & num_cont_hb(maxres),jcont_hb(20,maxres)
4841 num_kont=num_cont_hb(atom)
4845 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4848 buffer(i,indx+22)=facont_hb(i,atom)
4849 buffer(i,indx+23)=ees0p(i,atom)
4850 buffer(i,indx+24)=ees0m(i,atom)
4851 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4853 buffer(1,indx+26)=dfloat(num_kont)
4856 c------------------------------------------------------------------------------
4857 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4858 implicit real*8 (a-h,o-z)
4859 include 'DIMENSIONS'
4860 integer dimen1,dimen2,atom,indx
4861 double precision buffer(dimen1,dimen2)
4862 double precision zapas
4863 common /contacts_hb/ zapas(3,20,maxres,7),
4864 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4865 & num_cont_hb(maxres),jcont_hb(20,maxres)
4866 num_kont=buffer(1,indx+26)
4867 num_kont_old=num_cont_hb(atom)
4868 num_cont_hb(atom)=num_kont+num_kont_old
4873 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4876 facont_hb(ii,atom)=buffer(i,indx+22)
4877 ees0p(ii,atom)=buffer(i,indx+23)
4878 ees0m(ii,atom)=buffer(i,indx+24)
4879 jcont_hb(ii,atom)=buffer(i,indx+25)
4883 c------------------------------------------------------------------------------
4885 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4886 C This subroutine calculates multi-body contributions to hydrogen-bonding
4887 implicit real*8 (a-h,o-z)
4888 include 'DIMENSIONS'
4889 include 'sizesclu.dat'
4890 include 'COMMON.IOUNITS'
4892 include 'COMMON.INFO'
4894 include 'COMMON.FFIELD'
4895 include 'COMMON.DERIV'
4896 include 'COMMON.INTERACT'
4897 include 'COMMON.CONTACTS'
4899 parameter (max_cont=maxconts)
4900 parameter (max_dim=2*(8*3+2))
4901 parameter (msglen1=max_cont*max_dim*4)
4902 parameter (msglen2=2*msglen1)
4903 integer source,CorrelType,CorrelID,Error
4904 double precision buffer(max_cont,max_dim)
4906 double precision gx(3),gx1(3)
4909 C Set lprn=.true. for debugging
4914 if (fgProcs.le.1) goto 30
4916 write (iout,'(a)') 'Contact function values:'
4918 write (iout,'(2i3,50(1x,i2,f5.2))')
4919 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4920 & j=1,num_cont_hb(i))
4923 C Caution! Following code assumes that electrostatic interactions concerning
4924 C a given atom are split among at most two processors!
4934 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4937 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4938 if (MyRank.gt.0) then
4939 C Send correlation contributions to the preceding processor
4941 nn=num_cont_hb(iatel_s)
4942 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4943 cd write (iout,*) 'The BUFFER array:'
4945 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4947 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4949 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4950 C Clear the contacts of the atom passed to the neighboring processor
4951 nn=num_cont_hb(iatel_s+1)
4953 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4955 num_cont_hb(iatel_s)=0
4957 cd write (iout,*) 'Processor ',MyID,MyRank,
4958 cd & ' is sending correlation contribution to processor',MyID-1,
4959 cd & ' msglen=',msglen
4960 cd write (*,*) 'Processor ',MyID,MyRank,
4961 cd & ' is sending correlation contribution to processor',MyID-1,
4962 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4963 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4964 cd write (iout,*) 'Processor ',MyID,
4965 cd & ' has sent correlation contribution to processor',MyID-1,
4966 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4967 cd write (*,*) 'Processor ',MyID,
4968 cd & ' has sent correlation contribution to processor',MyID-1,
4969 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4971 endif ! (MyRank.gt.0)
4975 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4976 if (MyRank.lt.fgProcs-1) then
4977 C Receive correlation contributions from the next processor
4979 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4980 cd write (iout,*) 'Processor',MyID,
4981 cd & ' is receiving correlation contribution from processor',MyID+1,
4982 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4983 cd write (*,*) 'Processor',MyID,
4984 cd & ' is receiving correlation contribution from processor',MyID+1,
4985 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4987 do while (nbytes.le.0)
4988 call mp_probe(MyID+1,CorrelType,nbytes)
4990 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4991 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4992 cd write (iout,*) 'Processor',MyID,
4993 cd & ' has received correlation contribution from processor',MyID+1,
4994 cd & ' msglen=',msglen,' nbytes=',nbytes
4995 cd write (iout,*) 'The received BUFFER array:'
4997 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4999 if (msglen.eq.msglen1) then
5000 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5001 else if (msglen.eq.msglen2) then
5002 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5003 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5006 & 'ERROR!!!! message length changed while processing correlations.'
5008 & 'ERROR!!!! message length changed while processing correlations.'
5009 call mp_stopall(Error)
5010 endif ! msglen.eq.msglen1
5011 endif ! MyRank.lt.fgProcs-1
5018 write (iout,'(a)') 'Contact function values:'
5020 write (iout,'(2i3,50(1x,i2,f5.2))')
5021 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5022 & j=1,num_cont_hb(i))
5026 C Remove the loop below after debugging !!!
5033 C Calculate the local-electrostatic correlation terms
5034 do i=iatel_s,iatel_e+1
5036 num_conti=num_cont_hb(i)
5037 num_conti1=num_cont_hb(i+1)
5042 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5043 c & ' jj=',jj,' kk=',kk
5044 if (j1.eq.j+1 .or. j1.eq.j-1) then
5045 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5046 C The system gains extra energy.
5047 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5049 else if (j1.eq.j) then
5050 C Contacts I-J and I-(J+1) occur simultaneously.
5051 C The system loses extra energy.
5052 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5057 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5058 c & ' jj=',jj,' kk=',kk
5060 C Contacts I-J and (I+1)-J occur simultaneously.
5061 C The system loses extra energy.
5062 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5069 c------------------------------------------------------------------------------
5070 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5072 C This subroutine calculates multi-body contributions to hydrogen-bonding
5073 implicit real*8 (a-h,o-z)
5074 include 'DIMENSIONS'
5075 include 'sizesclu.dat'
5076 include 'COMMON.IOUNITS'
5078 include 'COMMON.INFO'
5080 include 'COMMON.FFIELD'
5081 include 'COMMON.DERIV'
5082 include 'COMMON.INTERACT'
5083 include 'COMMON.CONTACTS'
5085 parameter (max_cont=maxconts)
5086 parameter (max_dim=2*(8*3+2))
5087 parameter (msglen1=max_cont*max_dim*4)
5088 parameter (msglen2=2*msglen1)
5089 integer source,CorrelType,CorrelID,Error
5090 double precision buffer(max_cont,max_dim)
5092 double precision gx(3),gx1(3)
5095 C Set lprn=.true. for debugging
5102 if (fgProcs.le.1) goto 30
5104 write (iout,'(a)') 'Contact function values:'
5106 write (iout,'(2i3,50(1x,i2,f5.2))')
5107 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5108 & j=1,num_cont_hb(i))
5111 C Caution! Following code assumes that electrostatic interactions concerning
5112 C a given atom are split among at most two processors!
5122 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5125 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5126 if (MyRank.gt.0) then
5127 C Send correlation contributions to the preceding processor
5129 nn=num_cont_hb(iatel_s)
5130 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5131 cd write (iout,*) 'The BUFFER array:'
5133 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5135 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5137 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5138 C Clear the contacts of the atom passed to the neighboring processor
5139 nn=num_cont_hb(iatel_s+1)
5141 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5143 num_cont_hb(iatel_s)=0
5145 cd write (iout,*) 'Processor ',MyID,MyRank,
5146 cd & ' is sending correlation contribution to processor',MyID-1,
5147 cd & ' msglen=',msglen
5148 cd write (*,*) 'Processor ',MyID,MyRank,
5149 cd & ' is sending correlation contribution to processor',MyID-1,
5150 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5151 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5152 cd write (iout,*) 'Processor ',MyID,
5153 cd & ' has sent correlation contribution to processor',MyID-1,
5154 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5155 cd write (*,*) 'Processor ',MyID,
5156 cd & ' has sent correlation contribution to processor',MyID-1,
5157 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5159 endif ! (MyRank.gt.0)
5163 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5164 if (MyRank.lt.fgProcs-1) then
5165 C Receive correlation contributions from the next processor
5167 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5168 cd write (iout,*) 'Processor',MyID,
5169 cd & ' is receiving correlation contribution from processor',MyID+1,
5170 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5171 cd write (*,*) 'Processor',MyID,
5172 cd & ' is receiving correlation contribution from processor',MyID+1,
5173 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5175 do while (nbytes.le.0)
5176 call mp_probe(MyID+1,CorrelType,nbytes)
5178 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5179 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5180 cd write (iout,*) 'Processor',MyID,
5181 cd & ' has received correlation contribution from processor',MyID+1,
5182 cd & ' msglen=',msglen,' nbytes=',nbytes
5183 cd write (iout,*) 'The received BUFFER array:'
5185 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5187 if (msglen.eq.msglen1) then
5188 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5189 else if (msglen.eq.msglen2) then
5190 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5191 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5194 & 'ERROR!!!! message length changed while processing correlations.'
5196 & 'ERROR!!!! message length changed while processing correlations.'
5197 call mp_stopall(Error)
5198 endif ! msglen.eq.msglen1
5199 endif ! MyRank.lt.fgProcs-1
5206 write (iout,'(a)') 'Contact function values:'
5208 write (iout,'(2i3,50(1x,i2,f5.2))')
5209 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5210 & j=1,num_cont_hb(i))
5216 C Remove the loop below after debugging !!!
5223 C Calculate the dipole-dipole interaction energies
5224 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5225 do i=iatel_s,iatel_e+1
5226 num_conti=num_cont_hb(i)
5233 C Calculate the local-electrostatic correlation terms
5234 do i=iatel_s,iatel_e+1
5236 num_conti=num_cont_hb(i)
5237 num_conti1=num_cont_hb(i+1)
5242 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5243 c & ' jj=',jj,' kk=',kk
5244 if (j1.eq.j+1 .or. j1.eq.j-1) then
5245 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5246 C The system gains extra energy.
5248 sqd1=dsqrt(d_cont(jj,i))
5249 sqd2=dsqrt(d_cont(kk,i1))
5250 sred_geom = sqd1*sqd2
5251 IF (sred_geom.lt.cutoff_corr) THEN
5252 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5254 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5255 c & ' jj=',jj,' kk=',kk
5256 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5257 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5259 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5260 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5263 cd write (iout,*) 'sred_geom=',sred_geom,
5264 cd & ' ekont=',ekont,' fprim=',fprimcont
5265 call calc_eello(i,j,i+1,j1,jj,kk)
5266 if (wcorr4.gt.0.0d0)
5267 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5268 if (wcorr5.gt.0.0d0)
5269 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5270 c print *,"wcorr5",ecorr5
5271 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5272 cd write(2,*)'ijkl',i,j,i+1,j1
5273 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5274 & .or. wturn6.eq.0.0d0))then
5275 c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5276 c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5277 c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5278 c & 'ecorr6=',ecorr6, wcorr6
5279 cd write (iout,'(4e15.5)') sred_geom,
5280 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5281 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5282 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5283 else if (wturn6.gt.0.0d0
5284 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5285 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5286 eturn6=eturn6+eello_turn6(i,jj,kk)
5287 cd write (2,*) 'multibody_eello:eturn6',eturn6
5291 else if (j1.eq.j) then
5292 C Contacts I-J and I-(J+1) occur simultaneously.
5293 C The system loses extra energy.
5294 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5299 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5300 c & ' jj=',jj,' kk=',kk
5302 C Contacts I-J and (I+1)-J occur simultaneously.
5303 C The system loses extra energy.
5304 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5311 c------------------------------------------------------------------------------
5312 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5313 implicit real*8 (a-h,o-z)
5314 include 'DIMENSIONS'
5315 include 'COMMON.IOUNITS'
5316 include 'COMMON.DERIV'
5317 include 'COMMON.INTERACT'
5318 include 'COMMON.CONTACTS'
5319 double precision gx(3),gx1(3)
5329 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5330 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5331 C Following 4 lines for diagnostics.
5336 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5338 c write (iout,*)'Contacts have occurred for peptide groups',
5339 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5340 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5341 C Calculate the multi-body contribution to energy.
5342 ecorr=ecorr+ekont*ees
5344 C Calculate multi-body contributions to the gradient.
5346 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5347 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5348 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5349 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5350 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5351 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5352 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5353 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5354 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5355 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5356 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5357 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5358 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5359 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5363 gradcorr(ll,m)=gradcorr(ll,m)+
5364 & ees*ekl*gacont_hbr(ll,jj,i)-
5365 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5366 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5371 gradcorr(ll,m)=gradcorr(ll,m)+
5372 & ees*eij*gacont_hbr(ll,kk,k)-
5373 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5374 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5381 C---------------------------------------------------------------------------
5382 subroutine dipole(i,j,jj)
5383 implicit real*8 (a-h,o-z)
5384 include 'DIMENSIONS'
5385 include 'sizesclu.dat'
5386 include 'COMMON.IOUNITS'
5387 include 'COMMON.CHAIN'
5388 include 'COMMON.FFIELD'
5389 include 'COMMON.DERIV'
5390 include 'COMMON.INTERACT'
5391 include 'COMMON.CONTACTS'
5392 include 'COMMON.TORSION'
5393 include 'COMMON.VAR'
5394 include 'COMMON.GEO'
5395 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5397 iti1 = itortyp(itype(i+1))
5398 if (j.lt.nres-1) then
5399 itj1 = itortyp(itype(j+1))
5404 dipi(iii,1)=Ub2(iii,i)
5405 dipderi(iii)=Ub2der(iii,i)
5406 dipi(iii,2)=b1(iii,iti1)
5407 dipj(iii,1)=Ub2(iii,j)
5408 dipderj(iii)=Ub2der(iii,j)
5409 dipj(iii,2)=b1(iii,itj1)
5413 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5416 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5419 if (.not.calc_grad) return
5424 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5428 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5433 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5434 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5436 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5438 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5440 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5444 C---------------------------------------------------------------------------
5445 subroutine calc_eello(i,j,k,l,jj,kk)
5447 C This subroutine computes matrices and vectors needed to calculate
5448 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5450 implicit real*8 (a-h,o-z)
5451 include 'DIMENSIONS'
5452 include 'sizesclu.dat'
5453 include 'COMMON.IOUNITS'
5454 include 'COMMON.CHAIN'
5455 include 'COMMON.DERIV'
5456 include 'COMMON.INTERACT'
5457 include 'COMMON.CONTACTS'
5458 include 'COMMON.TORSION'
5459 include 'COMMON.VAR'
5460 include 'COMMON.GEO'
5461 include 'COMMON.FFIELD'
5462 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5463 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5466 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5467 cd & ' jj=',jj,' kk=',kk
5468 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5471 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5472 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5475 call transpose2(aa1(1,1),aa1t(1,1))
5476 call transpose2(aa2(1,1),aa2t(1,1))
5479 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5480 & aa1tder(1,1,lll,kkk))
5481 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5482 & aa2tder(1,1,lll,kkk))
5486 C parallel orientation of the two CA-CA-CA frames.
5488 iti=itortyp(itype(i))
5492 itk1=itortyp(itype(k+1))
5493 itj=itortyp(itype(j))
5494 if (l.lt.nres-1) then
5495 itl1=itortyp(itype(l+1))
5499 C A1 kernel(j+1) A2T
5501 cd write (iout,'(3f10.5,5x,3f10.5)')
5502 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5504 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5505 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5506 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5507 C Following matrices are needed only for 6-th order cumulants
5508 IF (wcorr6.gt.0.0d0) THEN
5509 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5510 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5511 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5512 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5513 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5514 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5515 & ADtEAderx(1,1,1,1,1,1))
5517 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5518 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5519 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5520 & ADtEA1derx(1,1,1,1,1,1))
5522 C End 6-th order cumulants
5525 cd write (2,*) 'In calc_eello6'
5527 cd write (2,*) 'iii=',iii
5529 cd write (2,*) 'kkk=',kkk
5531 cd write (2,'(3(2f10.5),5x)')
5532 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5537 call transpose2(EUgder(1,1,k),auxmat(1,1))
5538 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5539 call transpose2(EUg(1,1,k),auxmat(1,1))
5540 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5541 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5545 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5546 & EAEAderx(1,1,lll,kkk,iii,1))
5550 C A1T kernel(i+1) A2
5551 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5552 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5553 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5554 C Following matrices are needed only for 6-th order cumulants
5555 IF (wcorr6.gt.0.0d0) THEN
5556 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5557 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5558 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5559 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5560 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5561 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5562 & ADtEAderx(1,1,1,1,1,2))
5563 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5564 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5565 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5566 & ADtEA1derx(1,1,1,1,1,2))
5568 C End 6-th order cumulants
5569 call transpose2(EUgder(1,1,l),auxmat(1,1))
5570 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5571 call transpose2(EUg(1,1,l),auxmat(1,1))
5572 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5573 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5577 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5578 & EAEAderx(1,1,lll,kkk,iii,2))
5583 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5584 C They are needed only when the fifth- or the sixth-order cumulants are
5586 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5587 call transpose2(AEA(1,1,1),auxmat(1,1))
5588 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5589 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5590 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5591 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5592 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5593 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5594 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5595 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5596 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5597 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5598 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5599 call transpose2(AEA(1,1,2),auxmat(1,1))
5600 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5601 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5602 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5603 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5604 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5605 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5606 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5607 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5608 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5609 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5610 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5611 C Calculate the Cartesian derivatives of the vectors.
5615 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5616 call matvec2(auxmat(1,1),b1(1,iti),
5617 & AEAb1derx(1,lll,kkk,iii,1,1))
5618 call matvec2(auxmat(1,1),Ub2(1,i),
5619 & AEAb2derx(1,lll,kkk,iii,1,1))
5620 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5621 & AEAb1derx(1,lll,kkk,iii,2,1))
5622 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5623 & AEAb2derx(1,lll,kkk,iii,2,1))
5624 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5625 call matvec2(auxmat(1,1),b1(1,itj),
5626 & AEAb1derx(1,lll,kkk,iii,1,2))
5627 call matvec2(auxmat(1,1),Ub2(1,j),
5628 & AEAb2derx(1,lll,kkk,iii,1,2))
5629 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5630 & AEAb1derx(1,lll,kkk,iii,2,2))
5631 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5632 & AEAb2derx(1,lll,kkk,iii,2,2))
5639 C Antiparallel orientation of the two CA-CA-CA frames.
5641 iti=itortyp(itype(i))
5645 itk1=itortyp(itype(k+1))
5646 itl=itortyp(itype(l))
5647 itj=itortyp(itype(j))
5648 if (j.lt.nres-1) then
5649 itj1=itortyp(itype(j+1))
5653 C A2 kernel(j-1)T A1T
5654 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5655 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5656 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5657 C Following matrices are needed only for 6-th order cumulants
5658 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5659 & j.eq.i+4 .and. l.eq.i+3)) THEN
5660 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5661 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5662 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5663 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5664 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5665 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5666 & ADtEAderx(1,1,1,1,1,1))
5667 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5668 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5669 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5670 & ADtEA1derx(1,1,1,1,1,1))
5672 C End 6-th order cumulants
5673 call transpose2(EUgder(1,1,k),auxmat(1,1))
5674 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5675 call transpose2(EUg(1,1,k),auxmat(1,1))
5676 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5677 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5681 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5682 & EAEAderx(1,1,lll,kkk,iii,1))
5686 C A2T kernel(i+1)T A1
5687 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5688 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5689 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5690 C Following matrices are needed only for 6-th order cumulants
5691 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5692 & j.eq.i+4 .and. l.eq.i+3)) THEN
5693 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5694 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5695 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5696 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5697 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5698 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5699 & ADtEAderx(1,1,1,1,1,2))
5700 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5701 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5702 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5703 & ADtEA1derx(1,1,1,1,1,2))
5705 C End 6-th order cumulants
5706 call transpose2(EUgder(1,1,j),auxmat(1,1))
5707 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5708 call transpose2(EUg(1,1,j),auxmat(1,1))
5709 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5710 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5714 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5715 & EAEAderx(1,1,lll,kkk,iii,2))
5720 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5721 C They are needed only when the fifth- or the sixth-order cumulants are
5723 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5724 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5725 call transpose2(AEA(1,1,1),auxmat(1,1))
5726 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5727 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5728 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5729 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5730 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5731 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5732 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5733 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5734 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5735 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5736 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5737 call transpose2(AEA(1,1,2),auxmat(1,1))
5738 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5739 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5740 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5741 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5742 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5743 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5744 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5745 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5746 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5747 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5748 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5749 C Calculate the Cartesian derivatives of the vectors.
5753 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5754 call matvec2(auxmat(1,1),b1(1,iti),
5755 & AEAb1derx(1,lll,kkk,iii,1,1))
5756 call matvec2(auxmat(1,1),Ub2(1,i),
5757 & AEAb2derx(1,lll,kkk,iii,1,1))
5758 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5759 & AEAb1derx(1,lll,kkk,iii,2,1))
5760 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5761 & AEAb2derx(1,lll,kkk,iii,2,1))
5762 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5763 call matvec2(auxmat(1,1),b1(1,itl),
5764 & AEAb1derx(1,lll,kkk,iii,1,2))
5765 call matvec2(auxmat(1,1),Ub2(1,l),
5766 & AEAb2derx(1,lll,kkk,iii,1,2))
5767 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5768 & AEAb1derx(1,lll,kkk,iii,2,2))
5769 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5770 & AEAb2derx(1,lll,kkk,iii,2,2))
5779 C---------------------------------------------------------------------------
5780 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5781 & KK,KKderg,AKA,AKAderg,AKAderx)
5785 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5786 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5787 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5792 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5794 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5797 cd if (lprn) write (2,*) 'In kernel'
5799 cd if (lprn) write (2,*) 'kkk=',kkk
5801 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5802 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5804 cd write (2,*) 'lll=',lll
5805 cd write (2,*) 'iii=1'
5807 cd write (2,'(3(2f10.5),5x)')
5808 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5811 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5812 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5814 cd write (2,*) 'lll=',lll
5815 cd write (2,*) 'iii=2'
5817 cd write (2,'(3(2f10.5),5x)')
5818 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5825 C---------------------------------------------------------------------------
5826 double precision function eello4(i,j,k,l,jj,kk)
5827 implicit real*8 (a-h,o-z)
5828 include 'DIMENSIONS'
5829 include 'sizesclu.dat'
5830 include 'COMMON.IOUNITS'
5831 include 'COMMON.CHAIN'
5832 include 'COMMON.DERIV'
5833 include 'COMMON.INTERACT'
5834 include 'COMMON.CONTACTS'
5835 include 'COMMON.TORSION'
5836 include 'COMMON.VAR'
5837 include 'COMMON.GEO'
5838 double precision pizda(2,2),ggg1(3),ggg2(3)
5839 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5843 cd print *,'eello4:',i,j,k,l,jj,kk
5844 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5845 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5846 cold eij=facont_hb(jj,i)
5847 cold ekl=facont_hb(kk,k)
5849 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5851 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5852 gcorr_loc(k-1)=gcorr_loc(k-1)
5853 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5855 gcorr_loc(l-1)=gcorr_loc(l-1)
5856 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5858 gcorr_loc(j-1)=gcorr_loc(j-1)
5859 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5864 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5865 & -EAEAderx(2,2,lll,kkk,iii,1)
5866 cd derx(lll,kkk,iii)=0.0d0
5870 cd gcorr_loc(l-1)=0.0d0
5871 cd gcorr_loc(j-1)=0.0d0
5872 cd gcorr_loc(k-1)=0.0d0
5874 cd write (iout,*)'Contacts have occurred for peptide groups',
5875 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5876 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5877 if (j.lt.nres-1) then
5884 if (l.lt.nres-1) then
5892 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5893 ggg1(ll)=eel4*g_contij(ll,1)
5894 ggg2(ll)=eel4*g_contij(ll,2)
5895 ghalf=0.5d0*ggg1(ll)
5897 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5898 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5899 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5900 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5901 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5902 ghalf=0.5d0*ggg2(ll)
5904 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5905 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5906 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5907 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5912 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5913 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5918 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5919 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5925 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5930 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5934 cd write (2,*) iii,gcorr_loc(iii)
5938 cd write (2,*) 'ekont',ekont
5939 cd write (iout,*) 'eello4',ekont*eel4
5942 C---------------------------------------------------------------------------
5943 double precision function eello5(i,j,k,l,jj,kk)
5944 implicit real*8 (a-h,o-z)
5945 include 'DIMENSIONS'
5946 include 'sizesclu.dat'
5947 include 'COMMON.IOUNITS'
5948 include 'COMMON.CHAIN'
5949 include 'COMMON.DERIV'
5950 include 'COMMON.INTERACT'
5951 include 'COMMON.CONTACTS'
5952 include 'COMMON.TORSION'
5953 include 'COMMON.VAR'
5954 include 'COMMON.GEO'
5955 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5956 double precision ggg1(3),ggg2(3)
5957 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5962 C /l\ / \ \ / \ / \ / C
5963 C / \ / \ \ / \ / \ / C
5964 C j| o |l1 | o | o| o | | o |o C
5965 C \ |/k\| |/ \| / |/ \| |/ \| C
5966 C \i/ \ / \ / / \ / \ C
5968 C (I) (II) (III) (IV) C
5970 C eello5_1 eello5_2 eello5_3 eello5_4 C
5972 C Antiparallel chains C
5975 C /j\ / \ \ / \ / \ / C
5976 C / \ / \ \ / \ / \ / C
5977 C j1| o |l | o | o| o | | o |o C
5978 C \ |/k\| |/ \| / |/ \| |/ \| C
5979 C \i/ \ / \ / / \ / \ C
5981 C (I) (II) (III) (IV) C
5983 C eello5_1 eello5_2 eello5_3 eello5_4 C
5985 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5987 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5988 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5993 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5995 itk=itortyp(itype(k))
5996 itl=itortyp(itype(l))
5997 itj=itortyp(itype(j))
6002 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6003 cd & eel5_3_num,eel5_4_num)
6007 derx(lll,kkk,iii)=0.0d0
6011 cd eij=facont_hb(jj,i)
6012 cd ekl=facont_hb(kk,k)
6014 cd write (iout,*)'Contacts have occurred for peptide groups',
6015 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6017 C Contribution from the graph I.
6018 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6019 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6020 call transpose2(EUg(1,1,k),auxmat(1,1))
6021 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6022 vv(1)=pizda(1,1)-pizda(2,2)
6023 vv(2)=pizda(1,2)+pizda(2,1)
6024 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6025 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6027 C Explicit gradient in virtual-dihedral angles.
6028 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6029 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6030 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6031 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6032 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6033 vv(1)=pizda(1,1)-pizda(2,2)
6034 vv(2)=pizda(1,2)+pizda(2,1)
6035 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6036 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6037 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6038 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6039 vv(1)=pizda(1,1)-pizda(2,2)
6040 vv(2)=pizda(1,2)+pizda(2,1)
6042 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6043 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6044 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6046 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6047 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6048 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6050 C Cartesian gradient
6054 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6056 vv(1)=pizda(1,1)-pizda(2,2)
6057 vv(2)=pizda(1,2)+pizda(2,1)
6058 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6059 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6060 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6067 C Contribution from graph II
6068 call transpose2(EE(1,1,itk),auxmat(1,1))
6069 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6070 vv(1)=pizda(1,1)+pizda(2,2)
6071 vv(2)=pizda(2,1)-pizda(1,2)
6072 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6073 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6075 C Explicit gradient in virtual-dihedral angles.
6076 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6077 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6078 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6079 vv(1)=pizda(1,1)+pizda(2,2)
6080 vv(2)=pizda(2,1)-pizda(1,2)
6082 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6083 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6084 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6086 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6087 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6088 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6090 C Cartesian gradient
6094 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6096 vv(1)=pizda(1,1)+pizda(2,2)
6097 vv(2)=pizda(2,1)-pizda(1,2)
6098 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6099 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6100 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6109 C Parallel orientation
6110 C Contribution from graph III
6111 call transpose2(EUg(1,1,l),auxmat(1,1))
6112 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6113 vv(1)=pizda(1,1)-pizda(2,2)
6114 vv(2)=pizda(1,2)+pizda(2,1)
6115 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6116 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6118 C Explicit gradient in virtual-dihedral angles.
6119 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6120 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6121 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6122 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6123 vv(1)=pizda(1,1)-pizda(2,2)
6124 vv(2)=pizda(1,2)+pizda(2,1)
6125 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6126 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6127 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6128 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6129 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6130 vv(1)=pizda(1,1)-pizda(2,2)
6131 vv(2)=pizda(1,2)+pizda(2,1)
6132 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6133 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6134 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6135 C Cartesian gradient
6139 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6141 vv(1)=pizda(1,1)-pizda(2,2)
6142 vv(2)=pizda(1,2)+pizda(2,1)
6143 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6144 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6145 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6151 C Contribution from graph IV
6153 call transpose2(EE(1,1,itl),auxmat(1,1))
6154 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6155 vv(1)=pizda(1,1)+pizda(2,2)
6156 vv(2)=pizda(2,1)-pizda(1,2)
6157 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6158 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6160 C Explicit gradient in virtual-dihedral angles.
6161 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6162 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6163 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6164 vv(1)=pizda(1,1)+pizda(2,2)
6165 vv(2)=pizda(2,1)-pizda(1,2)
6166 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6167 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6168 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6169 C Cartesian gradient
6173 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6175 vv(1)=pizda(1,1)+pizda(2,2)
6176 vv(2)=pizda(2,1)-pizda(1,2)
6177 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6178 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6179 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6185 C Antiparallel orientation
6186 C Contribution from graph III
6188 call transpose2(EUg(1,1,j),auxmat(1,1))
6189 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6190 vv(1)=pizda(1,1)-pizda(2,2)
6191 vv(2)=pizda(1,2)+pizda(2,1)
6192 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6193 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6195 C Explicit gradient in virtual-dihedral angles.
6196 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6197 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6198 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6199 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6200 vv(1)=pizda(1,1)-pizda(2,2)
6201 vv(2)=pizda(1,2)+pizda(2,1)
6202 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6203 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6204 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6205 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6206 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6207 vv(1)=pizda(1,1)-pizda(2,2)
6208 vv(2)=pizda(1,2)+pizda(2,1)
6209 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6210 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6211 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6212 C Cartesian gradient
6216 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6218 vv(1)=pizda(1,1)-pizda(2,2)
6219 vv(2)=pizda(1,2)+pizda(2,1)
6220 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6221 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6222 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6228 C Contribution from graph IV
6230 call transpose2(EE(1,1,itj),auxmat(1,1))
6231 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6232 vv(1)=pizda(1,1)+pizda(2,2)
6233 vv(2)=pizda(2,1)-pizda(1,2)
6234 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6235 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6237 C Explicit gradient in virtual-dihedral angles.
6238 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6239 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6240 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6241 vv(1)=pizda(1,1)+pizda(2,2)
6242 vv(2)=pizda(2,1)-pizda(1,2)
6243 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6244 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6245 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6246 C Cartesian gradient
6250 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6252 vv(1)=pizda(1,1)+pizda(2,2)
6253 vv(2)=pizda(2,1)-pizda(1,2)
6254 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6255 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6256 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6263 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6264 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6265 cd write (2,*) 'ijkl',i,j,k,l
6266 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6267 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6269 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6270 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6271 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6272 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6274 if (j.lt.nres-1) then
6281 if (l.lt.nres-1) then
6291 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6293 ggg1(ll)=eel5*g_contij(ll,1)
6294 ggg2(ll)=eel5*g_contij(ll,2)
6295 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6296 ghalf=0.5d0*ggg1(ll)
6298 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6299 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6300 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6301 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6302 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6303 ghalf=0.5d0*ggg2(ll)
6305 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6306 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6307 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6308 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6313 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6314 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6319 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6320 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6326 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6331 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6335 cd write (2,*) iii,g_corr5_loc(iii)
6339 cd write (2,*) 'ekont',ekont
6340 cd write (iout,*) 'eello5',ekont*eel5
6343 c--------------------------------------------------------------------------
6344 double precision function eello6(i,j,k,l,jj,kk)
6345 implicit real*8 (a-h,o-z)
6346 include 'DIMENSIONS'
6347 include 'sizesclu.dat'
6348 include 'COMMON.IOUNITS'
6349 include 'COMMON.CHAIN'
6350 include 'COMMON.DERIV'
6351 include 'COMMON.INTERACT'
6352 include 'COMMON.CONTACTS'
6353 include 'COMMON.TORSION'
6354 include 'COMMON.VAR'
6355 include 'COMMON.GEO'
6356 include 'COMMON.FFIELD'
6357 double precision ggg1(3),ggg2(3)
6358 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6363 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6371 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6372 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6376 derx(lll,kkk,iii)=0.0d0
6380 cd eij=facont_hb(jj,i)
6381 cd ekl=facont_hb(kk,k)
6387 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6388 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6389 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6390 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6391 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6392 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6394 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6395 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6396 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6397 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6398 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6399 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6403 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6405 C If turn contributions are considered, they will be handled separately.
6406 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6407 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6408 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6409 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6410 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6411 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6412 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6415 if (j.lt.nres-1) then
6422 if (l.lt.nres-1) then
6430 ggg1(ll)=eel6*g_contij(ll,1)
6431 ggg2(ll)=eel6*g_contij(ll,2)
6432 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6433 ghalf=0.5d0*ggg1(ll)
6435 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6436 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6437 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6438 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6439 ghalf=0.5d0*ggg2(ll)
6440 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6442 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6443 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6444 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6445 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6450 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6451 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6456 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6457 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6463 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6468 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6472 cd write (2,*) iii,g_corr6_loc(iii)
6476 cd write (2,*) 'ekont',ekont
6477 cd write (iout,*) 'eello6',ekont*eel6
6480 c--------------------------------------------------------------------------
6481 double precision function eello6_graph1(i,j,k,l,imat,swap)
6482 implicit real*8 (a-h,o-z)
6483 include 'DIMENSIONS'
6484 include 'sizesclu.dat'
6485 include 'COMMON.IOUNITS'
6486 include 'COMMON.CHAIN'
6487 include 'COMMON.DERIV'
6488 include 'COMMON.INTERACT'
6489 include 'COMMON.CONTACTS'
6490 include 'COMMON.TORSION'
6491 include 'COMMON.VAR'
6492 include 'COMMON.GEO'
6493 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6497 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6499 C Parallel Antiparallel C
6505 C \ j|/k\| / \ |/k\|l / C
6510 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6511 itk=itortyp(itype(k))
6512 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6513 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6514 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6515 call transpose2(EUgC(1,1,k),auxmat(1,1))
6516 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6517 vv1(1)=pizda1(1,1)-pizda1(2,2)
6518 vv1(2)=pizda1(1,2)+pizda1(2,1)
6519 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6520 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6521 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6522 s5=scalar2(vv(1),Dtobr2(1,i))
6523 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6524 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6525 if (.not. calc_grad) return
6526 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6527 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6528 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6529 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6530 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6531 & +scalar2(vv(1),Dtobr2der(1,i)))
6532 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6533 vv1(1)=pizda1(1,1)-pizda1(2,2)
6534 vv1(2)=pizda1(1,2)+pizda1(2,1)
6535 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6536 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6538 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6539 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6540 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6541 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6542 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6544 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6545 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6546 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6547 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6548 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6550 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6551 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6552 vv1(1)=pizda1(1,1)-pizda1(2,2)
6553 vv1(2)=pizda1(1,2)+pizda1(2,1)
6554 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6555 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6556 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6557 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6566 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6567 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6568 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6569 call transpose2(EUgC(1,1,k),auxmat(1,1))
6570 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6572 vv1(1)=pizda1(1,1)-pizda1(2,2)
6573 vv1(2)=pizda1(1,2)+pizda1(2,1)
6574 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6575 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6576 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6577 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6578 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6579 s5=scalar2(vv(1),Dtobr2(1,i))
6580 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6586 c----------------------------------------------------------------------------
6587 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6588 implicit real*8 (a-h,o-z)
6589 include 'DIMENSIONS'
6590 include 'sizesclu.dat'
6591 include 'COMMON.IOUNITS'
6592 include 'COMMON.CHAIN'
6593 include 'COMMON.DERIV'
6594 include 'COMMON.INTERACT'
6595 include 'COMMON.CONTACTS'
6596 include 'COMMON.TORSION'
6597 include 'COMMON.VAR'
6598 include 'COMMON.GEO'
6600 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6601 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6604 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6606 C Parallel Antiparallel C
6612 C \ j|/k\| \ |/k\|l C
6617 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6618 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6619 C AL 7/4/01 s1 would occur in the sixth-order moment,
6620 C but not in a cluster cumulant
6622 s1=dip(1,jj,i)*dip(1,kk,k)
6624 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6625 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6626 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6627 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6628 call transpose2(EUg(1,1,k),auxmat(1,1))
6629 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6630 vv(1)=pizda(1,1)-pizda(2,2)
6631 vv(2)=pizda(1,2)+pizda(2,1)
6632 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6633 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6635 eello6_graph2=-(s1+s2+s3+s4)
6637 eello6_graph2=-(s2+s3+s4)
6640 if (.not. calc_grad) return
6641 C Derivatives in gamma(i-1)
6644 s1=dipderg(1,jj,i)*dip(1,kk,k)
6646 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6647 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6648 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6649 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6651 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6653 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6655 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6657 C Derivatives in gamma(k-1)
6659 s1=dip(1,jj,i)*dipderg(1,kk,k)
6661 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6662 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6663 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6664 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6665 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6666 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6667 vv(1)=pizda(1,1)-pizda(2,2)
6668 vv(2)=pizda(1,2)+pizda(2,1)
6669 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6671 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6673 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6675 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6676 C Derivatives in gamma(j-1) or gamma(l-1)
6679 s1=dipderg(3,jj,i)*dip(1,kk,k)
6681 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6682 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6683 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6684 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6685 vv(1)=pizda(1,1)-pizda(2,2)
6686 vv(2)=pizda(1,2)+pizda(2,1)
6687 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6690 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6692 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6695 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6696 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6698 C Derivatives in gamma(l-1) or gamma(j-1)
6701 s1=dip(1,jj,i)*dipderg(3,kk,k)
6703 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6704 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6705 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6706 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6707 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6708 vv(1)=pizda(1,1)-pizda(2,2)
6709 vv(2)=pizda(1,2)+pizda(2,1)
6710 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6713 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6715 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6718 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6719 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6721 C Cartesian derivatives.
6723 write (2,*) 'In eello6_graph2'
6725 write (2,*) 'iii=',iii
6727 write (2,*) 'kkk=',kkk
6729 write (2,'(3(2f10.5),5x)')
6730 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6740 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6742 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6745 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6747 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6748 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6750 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6751 call transpose2(EUg(1,1,k),auxmat(1,1))
6752 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6754 vv(1)=pizda(1,1)-pizda(2,2)
6755 vv(2)=pizda(1,2)+pizda(2,1)
6756 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6757 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6759 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6761 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6764 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6766 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6773 c----------------------------------------------------------------------------
6774 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6775 implicit real*8 (a-h,o-z)
6776 include 'DIMENSIONS'
6777 include 'sizesclu.dat'
6778 include 'COMMON.IOUNITS'
6779 include 'COMMON.CHAIN'
6780 include 'COMMON.DERIV'
6781 include 'COMMON.INTERACT'
6782 include 'COMMON.CONTACTS'
6783 include 'COMMON.TORSION'
6784 include 'COMMON.VAR'
6785 include 'COMMON.GEO'
6786 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6788 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6790 C Parallel Antiparallel C
6796 C j|/k\| / |/k\|l / C
6801 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6803 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6804 C energy moment and not to the cluster cumulant.
6805 iti=itortyp(itype(i))
6806 if (j.lt.nres-1) then
6807 itj1=itortyp(itype(j+1))
6811 itk=itortyp(itype(k))
6812 itk1=itortyp(itype(k+1))
6813 if (l.lt.nres-1) then
6814 itl1=itortyp(itype(l+1))
6819 s1=dip(4,jj,i)*dip(4,kk,k)
6821 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6822 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6823 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6824 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6825 call transpose2(EE(1,1,itk),auxmat(1,1))
6826 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6827 vv(1)=pizda(1,1)+pizda(2,2)
6828 vv(2)=pizda(2,1)-pizda(1,2)
6829 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6830 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6832 eello6_graph3=-(s1+s2+s3+s4)
6834 eello6_graph3=-(s2+s3+s4)
6837 if (.not. calc_grad) return
6838 C Derivatives in gamma(k-1)
6839 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6840 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6841 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6842 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6843 C Derivatives in gamma(l-1)
6844 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6845 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6846 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6847 vv(1)=pizda(1,1)+pizda(2,2)
6848 vv(2)=pizda(2,1)-pizda(1,2)
6849 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6850 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6851 C Cartesian derivatives.
6857 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6859 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6862 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6864 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6865 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6867 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6868 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6870 vv(1)=pizda(1,1)+pizda(2,2)
6871 vv(2)=pizda(2,1)-pizda(1,2)
6872 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6874 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6876 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6879 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6881 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6883 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6889 c----------------------------------------------------------------------------
6890 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6891 implicit real*8 (a-h,o-z)
6892 include 'DIMENSIONS'
6893 include 'sizesclu.dat'
6894 include 'COMMON.IOUNITS'
6895 include 'COMMON.CHAIN'
6896 include 'COMMON.DERIV'
6897 include 'COMMON.INTERACT'
6898 include 'COMMON.CONTACTS'
6899 include 'COMMON.TORSION'
6900 include 'COMMON.VAR'
6901 include 'COMMON.GEO'
6902 include 'COMMON.FFIELD'
6903 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6904 & auxvec1(2),auxmat1(2,2)
6906 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6908 C Parallel Antiparallel C
6914 C \ j|/k\| \ |/k\|l C
6919 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6921 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6922 C energy moment and not to the cluster cumulant.
6923 cd write (2,*) 'eello_graph4: wturn6',wturn6
6924 iti=itortyp(itype(i))
6925 itj=itortyp(itype(j))
6926 if (j.lt.nres-1) then
6927 itj1=itortyp(itype(j+1))
6931 itk=itortyp(itype(k))
6932 if (k.lt.nres-1) then
6933 itk1=itortyp(itype(k+1))
6937 itl=itortyp(itype(l))
6938 if (l.lt.nres-1) then
6939 itl1=itortyp(itype(l+1))
6943 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6944 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6945 cd & ' itl',itl,' itl1',itl1
6948 s1=dip(3,jj,i)*dip(3,kk,k)
6950 s1=dip(2,jj,j)*dip(2,kk,l)
6953 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6954 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6956 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6957 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6959 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6960 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6962 call transpose2(EUg(1,1,k),auxmat(1,1))
6963 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6964 vv(1)=pizda(1,1)-pizda(2,2)
6965 vv(2)=pizda(2,1)+pizda(1,2)
6966 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6967 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6969 eello6_graph4=-(s1+s2+s3+s4)
6971 eello6_graph4=-(s2+s3+s4)
6973 if (.not. calc_grad) return
6974 C Derivatives in gamma(i-1)
6978 s1=dipderg(2,jj,i)*dip(3,kk,k)
6980 s1=dipderg(4,jj,j)*dip(2,kk,l)
6983 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6985 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6986 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6988 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6989 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6991 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6992 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6993 cd write (2,*) 'turn6 derivatives'
6995 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6997 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7001 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7003 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7007 C Derivatives in gamma(k-1)
7010 s1=dip(3,jj,i)*dipderg(2,kk,k)
7012 s1=dip(2,jj,j)*dipderg(4,kk,l)
7015 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7016 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7018 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7019 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7021 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7022 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7024 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7025 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7026 vv(1)=pizda(1,1)-pizda(2,2)
7027 vv(2)=pizda(2,1)+pizda(1,2)
7028 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7029 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7031 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7033 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7037 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7039 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7042 C Derivatives in gamma(j-1) or gamma(l-1)
7043 if (l.eq.j+1 .and. l.gt.1) then
7044 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7045 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7046 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7047 vv(1)=pizda(1,1)-pizda(2,2)
7048 vv(2)=pizda(2,1)+pizda(1,2)
7049 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7050 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7051 else if (j.gt.1) then
7052 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7053 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7054 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7055 vv(1)=pizda(1,1)-pizda(2,2)
7056 vv(2)=pizda(2,1)+pizda(1,2)
7057 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7058 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7059 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7061 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7064 C Cartesian derivatives.
7071 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7073 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7077 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7079 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7083 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7085 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7087 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7088 & b1(1,itj1),auxvec(1))
7089 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7091 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7092 & b1(1,itl1),auxvec(1))
7093 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7095 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7097 vv(1)=pizda(1,1)-pizda(2,2)
7098 vv(2)=pizda(2,1)+pizda(1,2)
7099 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7101 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7103 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7106 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7109 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7112 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7114 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7116 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7120 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7122 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7125 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7127 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7135 c----------------------------------------------------------------------------
7136 double precision function eello_turn6(i,jj,kk)
7137 implicit real*8 (a-h,o-z)
7138 include 'DIMENSIONS'
7139 include 'sizesclu.dat'
7140 include 'COMMON.IOUNITS'
7141 include 'COMMON.CHAIN'
7142 include 'COMMON.DERIV'
7143 include 'COMMON.INTERACT'
7144 include 'COMMON.CONTACTS'
7145 include 'COMMON.TORSION'
7146 include 'COMMON.VAR'
7147 include 'COMMON.GEO'
7148 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7149 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7151 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7152 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7153 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7154 C the respective energy moment and not to the cluster cumulant.
7159 iti=itortyp(itype(i))
7160 itk=itortyp(itype(k))
7161 itk1=itortyp(itype(k+1))
7162 itl=itortyp(itype(l))
7163 itj=itortyp(itype(j))
7164 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7165 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7166 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7171 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7173 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7177 derx_turn(lll,kkk,iii)=0.0d0
7184 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7186 cd write (2,*) 'eello6_5',eello6_5
7188 call transpose2(AEA(1,1,1),auxmat(1,1))
7189 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7190 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7191 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7195 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7196 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7197 s2 = scalar2(b1(1,itk),vtemp1(1))
7199 call transpose2(AEA(1,1,2),atemp(1,1))
7200 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7201 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7202 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7206 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7207 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7208 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7210 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7211 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7212 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7213 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7214 ss13 = scalar2(b1(1,itk),vtemp4(1))
7215 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7219 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7225 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7227 C Derivatives in gamma(i+2)
7229 call transpose2(AEA(1,1,1),auxmatd(1,1))
7230 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7231 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7232 call transpose2(AEAderg(1,1,2),atempd(1,1))
7233 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7234 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7238 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7239 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7240 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7246 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7247 C Derivatives in gamma(i+3)
7249 call transpose2(AEA(1,1,1),auxmatd(1,1))
7250 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7251 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7252 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7256 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7257 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7258 s2d = scalar2(b1(1,itk),vtemp1d(1))
7260 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7261 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7263 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7265 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7266 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7267 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7277 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7278 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7280 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7281 & -0.5d0*ekont*(s2d+s12d)
7283 C Derivatives in gamma(i+4)
7284 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7285 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7286 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7288 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7289 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7290 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7300 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7302 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7304 C Derivatives in gamma(i+5)
7306 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7307 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7308 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7312 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7313 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7314 s2d = scalar2(b1(1,itk),vtemp1d(1))
7316 call transpose2(AEA(1,1,2),atempd(1,1))
7317 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7318 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7322 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7323 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7325 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7326 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7327 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7337 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7338 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7340 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7341 & -0.5d0*ekont*(s2d+s12d)
7343 C Cartesian derivatives
7348 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7349 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7350 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7354 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7355 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7357 s2d = scalar2(b1(1,itk),vtemp1d(1))
7359 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7360 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7361 s8d = -(atempd(1,1)+atempd(2,2))*
7362 & scalar2(cc(1,1,itl),vtemp2(1))
7366 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7368 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7369 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7376 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7379 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7383 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7384 & - 0.5d0*(s8d+s12d)
7386 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7395 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7397 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7398 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7399 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7400 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7401 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7403 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7404 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7405 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7409 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7410 cd & 16*eel_turn6_num
7412 if (j.lt.nres-1) then
7419 if (l.lt.nres-1) then
7427 ggg1(ll)=eel_turn6*g_contij(ll,1)
7428 ggg2(ll)=eel_turn6*g_contij(ll,2)
7429 ghalf=0.5d0*ggg1(ll)
7431 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7432 & +ekont*derx_turn(ll,2,1)
7433 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7434 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7435 & +ekont*derx_turn(ll,4,1)
7436 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7437 ghalf=0.5d0*ggg2(ll)
7439 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7440 & +ekont*derx_turn(ll,2,2)
7441 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7442 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7443 & +ekont*derx_turn(ll,4,2)
7444 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7449 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7454 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7460 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7465 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7469 cd write (2,*) iii,g_corr6_loc(iii)
7472 eello_turn6=ekont*eel_turn6
7473 cd write (2,*) 'ekont',ekont
7474 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7477 crc-------------------------------------------------
7478 SUBROUTINE MATVEC2(A1,V1,V2)
7479 implicit real*8 (a-h,o-z)
7480 include 'DIMENSIONS'
7481 DIMENSION A1(2,2),V1(2),V2(2)
7485 c 3 VI=VI+A1(I,K)*V1(K)
7489 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7490 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7495 C---------------------------------------
7496 SUBROUTINE MATMAT2(A1,A2,A3)
7497 implicit real*8 (a-h,o-z)
7498 include 'DIMENSIONS'
7499 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7500 c DIMENSION AI3(2,2)
7504 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7510 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7511 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7512 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7513 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7521 c-------------------------------------------------------------------------
7522 double precision function scalar2(u,v)
7524 double precision u(2),v(2)
7527 scalar2=u(1)*v(1)+u(2)*v(2)
7531 C-----------------------------------------------------------------------------
7533 subroutine transpose2(a,at)
7535 double precision a(2,2),at(2,2)
7542 c--------------------------------------------------------------------------
7543 subroutine transpose(n,a,at)
7546 double precision a(n,n),at(n,n)
7554 C---------------------------------------------------------------------------
7555 subroutine prodmat3(a1,a2,kk,transp,prod)
7558 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7560 crc double precision auxmat(2,2),prod_(2,2)
7563 crc call transpose2(kk(1,1),auxmat(1,1))
7564 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7565 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7567 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7568 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7569 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7570 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7571 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7572 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7573 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7574 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7577 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7578 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7580 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7581 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7582 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7583 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7584 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7585 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7586 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7587 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7590 c call transpose2(a2(1,1),a2t(1,1))
7593 crc print *,((prod_(i,j),i=1,2),j=1,2)
7594 crc print *,((prod(i,j),i=1,2),j=1,2)
7598 C-----------------------------------------------------------------------------
7599 double precision function scalar(u,v)
7601 double precision u(3),v(3)