1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
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,106) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
49 106 call emomo(evdw,evdw_p,evdw_m)
51 C Calculate electrostatic (H-bonding) energy of the main chain.
53 107 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
55 C Calculate excluded-volume interaction energy between peptide groups
58 call escp(evdw2,evdw2_14)
60 c Calculate the bond-stretching energy
63 c write (iout,*) "estr",estr
65 C Calculate the disulfide-bridge and other energy and the contributions
66 C from other distance constraints.
67 cd print *,'Calling EHPB'
69 cd print *,'EHPB exitted succesfully.'
71 C Calculate the virtual-bond-angle energy.
74 cd print *,'Bend energy finished.'
76 C Calculate the SC local energy.
79 cd print *,'SCLOC energy finished.'
81 C Calculate the virtual-bond torsional energy.
83 cd print *,'nterm=',nterm
84 call etor(etors,edihcnstr,fact(1))
86 C 6/23/01 Calculate double-torsional energy
88 call etor_d(etors_d,fact(2))
90 C 21/5/07 Calculate local sicdechain correlation energy
92 call eback_sc_corr(esccor)
94 C 12/1/95 Multi-body terms
98 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
99 & .or. wturn6.gt.0.0d0) then
100 c print *,"calling multibody_eello"
101 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
102 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
103 c print *,ecorr,ecorr5,ecorr6,eturn6
105 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
106 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
108 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
110 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
112 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
113 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
114 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
115 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
116 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
117 & +wbond*estr+wsccor*fact(1)*esccor
119 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
120 & +welec*fact(1)*(ees+evdw1)
121 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
122 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
123 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
124 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
125 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
126 & +wbond*estr+wsccor*fact(1)*esccor
131 energia(2)=evdw2-evdw2_14
148 energia(8)=eello_turn3
149 energia(9)=eello_turn4
158 energia(20)=edihcnstr
163 if (isnan(etot).ne.0) energia(0)=1.0d+99
165 if (isnan(etot)) energia(0)=1.0d+99
170 idumm=proc_proc(etot,i)
172 call proc_proc(etot,i)
174 if(i.eq.1)energia(0)=1.0d+99
181 C Sum up the components of the Cartesian gradient.
186 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
187 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
189 & wstrain*ghpbc(j,i)+
190 & wcorr*fact(3)*gradcorr(j,i)+
191 & wel_loc*fact(2)*gel_loc(j,i)+
192 & wturn3*fact(2)*gcorr3_turn(j,i)+
193 & wturn4*fact(3)*gcorr4_turn(j,i)+
194 & wcorr5*fact(4)*gradcorr5(j,i)+
195 & wcorr6*fact(5)*gradcorr6(j,i)+
196 & wturn6*fact(5)*gcorr6_turn(j,i)+
197 & wsccor*fact(2)*gsccorc(j,i)
198 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
200 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
201 & wsccor*fact(2)*gsccorx(j,i)
206 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
207 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
209 & wcorr*fact(3)*gradcorr(j,i)+
210 & wel_loc*fact(2)*gel_loc(j,i)+
211 & wturn3*fact(2)*gcorr3_turn(j,i)+
212 & wturn4*fact(3)*gcorr4_turn(j,i)+
213 & wcorr5*fact(4)*gradcorr5(j,i)+
214 & wcorr6*fact(5)*gradcorr6(j,i)+
215 & wturn6*fact(5)*gcorr6_turn(j,i)+
216 & wsccor*fact(2)*gsccorc(j,i)
217 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
219 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
220 & wsccor*fact(1)*gsccorx(j,i)
227 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
228 & +wcorr5*fact(4)*g_corr5_loc(i)
229 & +wcorr6*fact(5)*g_corr6_loc(i)
230 & +wturn4*fact(3)*gel_loc_turn4(i)
231 & +wturn3*fact(2)*gel_loc_turn3(i)
232 & +wturn6*fact(5)*gel_loc_turn6(i)
233 & +wel_loc*fact(2)*gel_loc_loc(i)
234 & +wsccor*fact(1)*gsccor_loc(i)
239 C------------------------------------------------------------------------
240 subroutine enerprint(energia,fact)
241 implicit real*8 (a-h,o-z)
243 include 'DIMENSIONS.ZSCOPT'
244 include 'COMMON.IOUNITS'
245 include 'COMMON.FFIELD'
246 include 'COMMON.SBRIDGE'
247 double precision energia(0:max_ene),fact(6)
249 evdw=energia(1)+fact(6)*energia(21)
251 evdw2=energia(2)+energia(17)
263 eello_turn3=energia(8)
264 eello_turn4=energia(9)
265 eello_turn6=energia(10)
272 edihcnstr=energia(20)
275 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
277 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
278 & etors_d,wtor_d*fact(2),ehpb,wstrain,
279 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
280 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
281 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
282 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
283 10 format (/'Virtual-chain energies:'//
284 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
285 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
286 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
287 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
288 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
289 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
290 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
291 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
292 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
293 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
294 & ' (SS bridges & dist. cnstr.)'/
295 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
297 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
298 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
299 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
300 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
301 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
302 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
303 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
304 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
305 & 'ETOT= ',1pE16.6,' (total)')
307 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
308 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
309 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
310 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
311 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
312 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
313 & edihcnstr,ebr*nss,etot
314 10 format (/'Virtual-chain energies:'//
315 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
316 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
317 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
318 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
319 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
320 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
321 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
322 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
323 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
324 & ' (SS bridges & dist. cnstr.)'/
325 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
327 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
328 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
329 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
330 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
331 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
332 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
333 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
334 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
335 & 'ETOT= ',1pE16.6,' (total)')
339 C-----------------------------------------------------------------------
340 subroutine elj(evdw,evdw_t)
342 C This subroutine calculates the interaction energy of nonbonded side chains
343 C assuming the LJ potential of interaction.
345 implicit real*8 (a-h,o-z)
347 include 'DIMENSIONS.ZSCOPT'
348 include "DIMENSIONS.COMPAR"
349 parameter (accur=1.0d-10)
352 include 'COMMON.LOCAL'
353 include 'COMMON.CHAIN'
354 include 'COMMON.DERIV'
355 include 'COMMON.INTERACT'
356 include 'COMMON.TORSION'
357 include 'COMMON.ENEPS'
358 include 'COMMON.SBRIDGE'
359 include 'COMMON.NAMES'
360 include 'COMMON.IOUNITS'
361 include 'COMMON.CONTACTS'
365 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
368 eneps_temp(j,i)=0.0d0
382 C Calculate SC interaction energy.
385 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
386 cd & 'iend=',iend(i,iint)
387 do j=istart(i,iint),iend(i,iint)
392 C Change 12/1/95 to calculate four-body interactions
393 rij=xj*xj+yj*yj+zj*zj
395 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
396 eps0ij=eps(itypi,itypj)
398 e1=fac*fac*aa(itypi,itypj)
399 e2=fac*bb(itypi,itypj)
401 ij=icant(itypi,itypj)
402 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
403 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
404 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
405 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
406 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
407 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
408 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
409 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
410 if (bb(itypi,itypj).gt.0.0d0) then
417 C Calculate the components of the gradient in DC and X
419 fac=-rrij*(e1+evdwij)
424 gvdwx(k,i)=gvdwx(k,i)-gg(k)
425 gvdwx(k,j)=gvdwx(k,j)+gg(k)
429 gvdwc(l,k)=gvdwc(l,k)+gg(l)
434 C 12/1/95, revised on 5/20/97
436 C Calculate the contact function. The ith column of the array JCONT will
437 C contain the numbers of atoms that make contacts with the atom I (of numbers
438 C greater than I). The arrays FACONT and GACONT will contain the values of
439 C the contact function and its derivative.
441 C Uncomment next line, if the correlation interactions include EVDW explicitly.
442 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
443 C Uncomment next line, if the correlation interactions are contact function only
444 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
446 sigij=sigma(itypi,itypj)
447 r0ij=rs0(itypi,itypj)
449 C Check whether the SC's are not too far to make a contact.
452 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
453 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
455 if (fcont.gt.0.0D0) then
456 C If the SC-SC distance if close to sigma, apply spline.
457 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
458 cAdam & fcont1,fprimcont1)
459 cAdam fcont1=1.0d0-fcont1
460 cAdam if (fcont1.gt.0.0d0) then
461 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
462 cAdam fcont=fcont*fcont1
464 C Uncomment following 4 lines to have the geometric average of the epsilon0's
465 cga eps0ij=1.0d0/dsqrt(eps0ij)
467 cga gg(k)=gg(k)*eps0ij
469 cga eps0ij=-evdwij*eps0ij
470 C Uncomment for AL's type of SC correlation interactions.
472 num_conti=num_conti+1
474 facont(num_conti,i)=fcont*eps0ij
475 fprimcont=eps0ij*fprimcont/rij
477 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
478 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
479 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
480 C Uncomment following 3 lines for Skolnick's type of SC correlation.
481 gacont(1,num_conti,i)=-fprimcont*xj
482 gacont(2,num_conti,i)=-fprimcont*yj
483 gacont(3,num_conti,i)=-fprimcont*zj
484 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
485 cd write (iout,'(2i3,3f10.5)')
486 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
492 num_cont(i)=num_conti
497 gvdwc(j,i)=expon*gvdwc(j,i)
498 gvdwx(j,i)=expon*gvdwx(j,i)
502 C******************************************************************************
506 C To save time, the factor of EXPON has been extracted from ALL components
507 C of GVDWC and GRADX. Remember to multiply them by this factor before further
510 C******************************************************************************
513 C-----------------------------------------------------------------------------
514 subroutine eljk(evdw,evdw_t)
516 C This subroutine calculates the interaction energy of nonbonded side chains
517 C assuming the LJK potential of interaction.
519 implicit real*8 (a-h,o-z)
521 include 'DIMENSIONS.ZSCOPT'
522 include "DIMENSIONS.COMPAR"
525 include 'COMMON.LOCAL'
526 include 'COMMON.CHAIN'
527 include 'COMMON.DERIV'
528 include 'COMMON.INTERACT'
529 include 'COMMON.ENEPS'
530 include 'COMMON.IOUNITS'
531 include 'COMMON.NAMES'
536 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
539 eneps_temp(j,i)=0.0d0
551 C Calculate SC interaction energy.
554 do j=istart(i,iint),iend(i,iint)
559 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
561 e_augm=augm(itypi,itypj)*fac_augm
564 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
565 fac=r_shift_inv**expon
566 e1=fac*fac*aa(itypi,itypj)
567 e2=fac*bb(itypi,itypj)
569 ij=icant(itypi,itypj)
570 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
571 & /dabs(eps(itypi,itypj))
572 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
573 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
574 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
575 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
576 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
577 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
578 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
579 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
580 if (bb(itypi,itypj).gt.0.0d0) then
587 C Calculate the components of the gradient in DC and X
589 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
594 gvdwx(k,i)=gvdwx(k,i)-gg(k)
595 gvdwx(k,j)=gvdwx(k,j)+gg(k)
599 gvdwc(l,k)=gvdwc(l,k)+gg(l)
609 gvdwc(j,i)=expon*gvdwc(j,i)
610 gvdwx(j,i)=expon*gvdwx(j,i)
616 C-----------------------------------------------------------------------------
617 subroutine ebp(evdw,evdw_t)
619 C This subroutine calculates the interaction energy of nonbonded side chains
620 C assuming the Berne-Pechukas potential of interaction.
622 implicit real*8 (a-h,o-z)
624 include 'DIMENSIONS.ZSCOPT'
625 include "DIMENSIONS.COMPAR"
628 include 'COMMON.LOCAL'
629 include 'COMMON.CHAIN'
630 include 'COMMON.DERIV'
631 include 'COMMON.NAMES'
632 include 'COMMON.INTERACT'
633 include 'COMMON.ENEPS'
634 include 'COMMON.IOUNITS'
635 include 'COMMON.CALC'
637 c double precision rrsave(maxdim)
643 eneps_temp(j,i)=0.0d0
648 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
649 c if (icall.eq.0) then
661 dxi=dc_norm(1,nres+i)
662 dyi=dc_norm(2,nres+i)
663 dzi=dc_norm(3,nres+i)
664 dsci_inv=vbld_inv(i+nres)
666 C Calculate SC interaction energy.
669 do j=istart(i,iint),iend(i,iint)
672 dscj_inv=vbld_inv(j+nres)
673 chi1=chi(itypi,itypj)
674 chi2=chi(itypj,itypi)
681 alf12=0.5D0*(alf1+alf2)
682 C For diagnostics only!!!
695 dxj=dc_norm(1,nres+j)
696 dyj=dc_norm(2,nres+j)
697 dzj=dc_norm(3,nres+j)
698 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
699 cd if (icall.eq.0) then
705 C Calculate the angle-dependent terms of energy & contributions to derivatives.
707 C Calculate whole angle-dependent part of epsilon and contributions
709 fac=(rrij*sigsq)**expon2
710 e1=fac*fac*aa(itypi,itypj)
711 e2=fac*bb(itypi,itypj)
712 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
713 eps2der=evdwij*eps3rt
714 eps3der=evdwij*eps2rt
715 evdwij=evdwij*eps2rt*eps3rt
716 ij=icant(itypi,itypj)
717 aux=eps1*eps2rt**2*eps3rt**2
718 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
719 & /dabs(eps(itypi,itypj))
720 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
721 if (bb(itypi,itypj).gt.0.0d0) then
728 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
729 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
730 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
731 cd & restyp(itypi),i,restyp(itypj),j,
732 cd & epsi,sigm,chi1,chi2,chip1,chip2,
733 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
734 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
737 C Calculate gradient components.
738 e1=e1*eps1*eps2rt**2*eps3rt**2
739 fac=-expon*(e1+evdwij)
742 C Calculate radial part of the gradient
746 C Calculate the angular part of the gradient and sum add the contributions
747 C to the appropriate components of the Cartesian gradient.
756 C-----------------------------------------------------------------------------
757 subroutine egb(evdw,evdw_t)
759 C This subroutine calculates the interaction energy of nonbonded side chains
760 C assuming the Gay-Berne potential of interaction.
762 implicit real*8 (a-h,o-z)
764 include 'DIMENSIONS.ZSCOPT'
765 include "DIMENSIONS.COMPAR"
768 include 'COMMON.LOCAL'
769 include 'COMMON.CHAIN'
770 include 'COMMON.DERIV'
771 include 'COMMON.NAMES'
772 include 'COMMON.INTERACT'
773 include 'COMMON.ENEPS'
774 include 'COMMON.IOUNITS'
775 include 'COMMON.CALC'
782 eneps_temp(j,i)=0.0d0
785 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
789 c if (icall.gt.0) lprn=.true.
797 dxi=dc_norm(1,nres+i)
798 dyi=dc_norm(2,nres+i)
799 dzi=dc_norm(3,nres+i)
800 dsci_inv=vbld_inv(i+nres)
802 C Calculate SC interaction energy.
805 do j=istart(i,iint),iend(i,iint)
808 dscj_inv=vbld_inv(j+nres)
809 sig0ij=sigma(itypi,itypj)
810 chi1=chi(itypi,itypj)
811 chi2=chi(itypj,itypi)
818 alf12=0.5D0*(alf1+alf2)
819 C For diagnostics only!!!
832 dxj=dc_norm(1,nres+j)
833 dyj=dc_norm(2,nres+j)
834 dzj=dc_norm(3,nres+j)
835 c write (iout,*) i,j,xj,yj,zj
836 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
838 C Calculate angle-dependent terms of energy and contributions to their
842 sig=sig0ij*dsqrt(sigsq)
843 rij_shift=1.0D0/rij-sig+sig0ij
844 C I hate to put IF's in the loops, but here don't have another choice!!!!
845 if (rij_shift.le.0.0D0) then
850 c---------------------------------------------------------------
851 rij_shift=1.0D0/rij_shift
853 e1=fac*fac*aa(itypi,itypj)
854 e2=fac*bb(itypi,itypj)
855 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
856 eps2der=evdwij*eps3rt
857 eps3der=evdwij*eps2rt
858 evdwij=evdwij*eps2rt*eps3rt
859 if (bb(itypi,itypj).gt.0) then
864 ij=icant(itypi,itypj)
865 aux=eps1*eps2rt**2*eps3rt**2
866 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
867 & /dabs(eps(itypi,itypj))
868 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
869 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
870 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
871 c & aux*e2/eps(itypi,itypj)
873 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
874 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
875 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
876 & restyp(itypi),i,restyp(itypj),j,
877 & epsi,sigm,chi1,chi2,chip1,chip2,
878 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
879 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
883 C Calculate gradient components.
884 e1=e1*eps1*eps2rt**2*eps3rt**2
885 fac=-expon*(e1+evdwij)*rij_shift
888 C Calculate the radial part of the gradient
892 C Calculate angular part of the gradient.
900 C-----------------------------------------------------------------------------
901 subroutine egbv(evdw,evdw_t)
903 C This subroutine calculates the interaction energy of nonbonded side chains
904 C assuming the Gay-Berne-Vorobjev potential of interaction.
906 implicit real*8 (a-h,o-z)
908 include 'DIMENSIONS.ZSCOPT'
909 include "DIMENSIONS.COMPAR"
912 include 'COMMON.LOCAL'
913 include 'COMMON.CHAIN'
914 include 'COMMON.DERIV'
915 include 'COMMON.NAMES'
916 include 'COMMON.INTERACT'
917 include 'COMMON.ENEPS'
918 include 'COMMON.IOUNITS'
919 include 'COMMON.CALC'
926 eneps_temp(j,i)=0.0d0
931 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
934 c if (icall.gt.0) lprn=.true.
942 dxi=dc_norm(1,nres+i)
943 dyi=dc_norm(2,nres+i)
944 dzi=dc_norm(3,nres+i)
945 dsci_inv=vbld_inv(i+nres)
947 C Calculate SC interaction energy.
950 do j=istart(i,iint),iend(i,iint)
953 dscj_inv=vbld_inv(j+nres)
954 sig0ij=sigma(itypi,itypj)
956 chi1=chi(itypi,itypj)
957 chi2=chi(itypj,itypi)
964 alf12=0.5D0*(alf1+alf2)
965 C For diagnostics only!!!
978 dxj=dc_norm(1,nres+j)
979 dyj=dc_norm(2,nres+j)
980 dzj=dc_norm(3,nres+j)
981 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
983 C Calculate angle-dependent terms of energy and contributions to their
987 sig=sig0ij*dsqrt(sigsq)
988 rij_shift=1.0D0/rij-sig+r0ij
989 C I hate to put IF's in the loops, but here don't have another choice!!!!
990 if (rij_shift.le.0.0D0) then
995 c---------------------------------------------------------------
996 rij_shift=1.0D0/rij_shift
998 e1=fac*fac*aa(itypi,itypj)
999 e2=fac*bb(itypi,itypj)
1000 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1001 eps2der=evdwij*eps3rt
1002 eps3der=evdwij*eps2rt
1003 fac_augm=rrij**expon
1004 e_augm=augm(itypi,itypj)*fac_augm
1005 evdwij=evdwij*eps2rt*eps3rt
1006 if (bb(itypi,itypj).gt.0.0d0) then
1007 evdw=evdw+evdwij+e_augm
1009 evdw_t=evdw_t+evdwij+e_augm
1011 ij=icant(itypi,itypj)
1012 aux=eps1*eps2rt**2*eps3rt**2
1013 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1014 & /dabs(eps(itypi,itypj))
1015 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1016 c eneps_temp(ij)=eneps_temp(ij)
1017 c & +(evdwij+e_augm)/eps(itypi,itypj)
1019 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1020 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1021 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1022 c & restyp(itypi),i,restyp(itypj),j,
1023 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1024 c & chi1,chi2,chip1,chip2,
1025 c & eps1,eps2rt**2,eps3rt**2,
1026 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1030 C Calculate gradient components.
1031 e1=e1*eps1*eps2rt**2*eps3rt**2
1032 fac=-expon*(e1+evdwij)*rij_shift
1034 fac=rij*fac-2*expon*rrij*e_augm
1035 C Calculate the radial part of the gradient
1039 C Calculate angular part of the gradient.
1047 C-----------------------------------------------------------------------------
1050 SUBROUTINE emomo(evdw,evdw_p,evdw_m)
1052 C This subroutine calculates the interaction energy of nonbonded side chains
1053 C assuming the Gay-Berne potential of interaction.
1056 INCLUDE 'DIMENSIONS'
1057 INCLUDE 'DIMENSIONS.ZSCOPT'
1058 INCLUDE 'COMMON.CALC'
1059 INCLUDE 'COMMON.CONTROL'
1060 INCLUDE 'COMMON.CHAIN'
1061 INCLUDE 'COMMON.DERIV'
1062 INCLUDE 'COMMON.EMP'
1063 INCLUDE 'COMMON.GEO'
1064 INCLUDE 'COMMON.INTERACT'
1065 INCLUDE 'COMMON.IOUNITS'
1066 INCLUDE 'COMMON.LOCAL'
1067 INCLUDE 'COMMON.NAMES'
1068 INCLUDE 'COMMON.VAR'
1070 double precision scalar
1071 double precision ener(4)
1074 IF (energy_dec) write (iout,'(a)')
1075 & ' AAi i AAj j 1/rij Rtail Rhead evdwij Fcav Ecl
1076 & Egb Epol Fisocav Elj Equad evdw'
1081 ccccc energy_dec=.false.
1082 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1084 c if (icall.eq.0) lprn=.false.
1087 DO i = iatsc_s, iatsc_e
1089 c itypi1 = itype(i+1)
1090 dxi = dc_norm(1,nres+i)
1091 dyi = dc_norm(2,nres+i)
1092 dzi = dc_norm(3,nres+i)
1093 c dsci_inv=dsc_inv(itypi)
1094 dsci_inv = vbld_inv(i+nres)
1096 c ctail(k,1) = c(k, i+nres)
1097 c & - dtail(1,itypi,itypj) * dc_norm(k, nres+i)
1102 c!-------------------------------------------------------------------
1103 C Calculate SC interaction energy.
1104 DO iint = 1, nint_gr(i)
1105 DO j = istart(i,iint), iend(i,iint)
1106 c! initialize variables for electrostatic gradients
1107 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
1109 c dscj_inv = dsc_inv(itypj)
1110 dscj_inv = vbld_inv(j+nres)
1111 c! rij holds 1/(distance of Calpha atoms)
1112 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
1114 c!-------------------------------------------------------------------
1115 C Calculate angle-dependent terms of energy and contributions to their
1119 c! DO troll = 10, 5000
1123 c! sqom1 = om1 * om1
1124 c! sqom2 = om2 * om2
1125 c! sqom12 = om12 * om12
1126 c! rij = 5.0d0 / troll
1128 c! Rtail = troll / 5.0d0
1129 c! Rhead = troll / 5.0d0
1130 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1131 c! Rtail = dsqrt((Rtail**2)
1132 c! & +((dabs(dtail(1,itypi,itypj)-dtail(2,itypi,itypj)))**2))
1133 c! rij = 1.0d0/Rtail
1137 c! this should be in elgrad_init but om's are calculated by sc_angular
1138 c! which in turn is used by older potentials
1139 c! which proves how tangled UNRES code is >.<
1140 c! om = omega, sqom = om^2
1143 sqom12 = om12 * om12
1145 c! now we calculate EGB - Gey-Berne
1146 c! It will be summed up in evdwij and saved in evdw
1147 sigsq = 1.0D0 / sigsq
1148 sig = sig0ij * dsqrt(sigsq)
1149 c! rij_shift = 1.0D0 / rij - sig + sig0ij
1150 rij_shift = Rtail - sig + sig0ij
1151 c write (2,*) "Rtal",Rtail," sig",sig," sigsq",sigsq,
1152 c & " sig0ij",sig0ij
1153 c write (2,*) "rij_shift",rij_shift
1154 IF (rij_shift.le.0.0D0) THEN
1158 sigder = -sig * sigsq
1159 rij_shift = 1.0D0 / rij_shift
1160 fac = rij_shift**expon
1161 c1 = fac * fac * aa(itypi,itypj)
1163 ! Scale down the repulsive term for 1,4 interactions.
1164 if (iabs(j-i).le.4) c1 = 0.01d0 * c1
1167 c2 = fac * bb(itypi,itypj)
1169 c write (2,*) "eps1",eps1," eps2rt",eps2rt," eps3rt",eps3rt,
1170 c & " c1",c1," c2",c2
1171 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
1172 eps2der = eps3rt * evdwij
1173 eps3der = eps2rt * evdwij
1174 c! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
1175 evdwij = eps2rt * eps3rt * evdwij
1177 c! write (*,*) "Gey Berne = ", evdwij
1179 IF (bb(itypi,itypj).gt.0) THEN
1180 evdw_p = evdw_p + evdwij
1182 evdw_m = evdw_m + evdwij
1188 c!-------------------------------------------------------------------
1189 c! Calculate some components of GGB
1190 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
1191 fac = -expon * (c1 + evdwij) * rij_shift
1192 sigder = fac * sigder
1194 c! Calculate distance derivative
1201 c! write (*,*) "gg(1) = ", gg(1)
1202 c! write (*,*) "gg(2) = ", gg(2)
1203 c! write (*,*) "gg(3) = ", gg(3)
1204 c! The angular derivatives of GGB are brought together in sc_grad
1205 c!-------------------------------------------------------------------
1208 c! Catch gly-gly interactions to skip calculation of something that
1211 IF (itypi.eq.10.and.itypj.eq.10) THEN
1219 c! we are not 2 glycines, so we calculate Fcav (and maybe more)
1220 fac = chis1 * sqom1 + chis2 * sqom2
1221 & - 2.0d0 * chis12 * om1 * om2 * om12
1222 c! we will use pom later in Gcav, so dont mess with it!
1223 pom = 1.0d0 - chis1 * chis2 * sqom12
1225 Lambf = (1.0d0 - (fac / pom))
1226 Lambf = dsqrt(Lambf)
1229 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
1230 c! write (*,*) "sparrow = ", sparrow
1231 Chif = Rtail * sparrow
1232 ChiLambf = Chif * Lambf
1233 eagle = dsqrt(ChiLambf)
1234 bat = ChiLambf ** 11.0d0
1236 top = b1 * ( eagle + b2 * ChiLambf - b3 )
1237 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
1240 c! write (*,*) "sig1 = ",sig1
1241 c! write (*,*) "sig2 = ",sig2
1242 c! write (*,*) "Rtail = ",Rtail
1243 c! write (*,*) "sparrow = ",sparrow
1244 c! write (*,*) "Chis1 = ", chis1
1245 c! write (*,*) "Chis2 = ", chis2
1246 c! write (*,*) "Chis12 = ", chis12
1247 c! write (*,*) "om1 = ", om1
1248 c! write (*,*) "om2 = ", om2
1249 c! write (*,*) "om12 = ", om12
1250 c! write (*,*) "sqom1 = ", sqom1
1251 c! write (*,*) "sqom2 = ", sqom2
1252 c! write (*,*) "sqom12 = ", sqom12
1253 c! write (*,*) "Lambf = ",Lambf
1254 c! write (*,*) "b1 = ",b1
1255 c! write (*,*) "b2 = ",b2
1256 c! write (*,*) "b3 = ",b3
1257 c! write (*,*) "b4 = ",b4
1258 c! write (*,*) "top = ",top
1259 c! write (*,*) "bot = ",bot
1262 c! write (*,*) "Fcav = ", Fcav
1263 c!-------------------------------------------------------------------
1264 c! derivative of Fcav is Gcav...
1265 c!---------------------------------------------------
1267 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
1268 dbot = 12.0d0 * b4 * bat * Lambf
1269 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
1271 c! write (*,*) "dFcav/dR = ", dFdR
1273 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
1274 dbot = 12.0d0 * b4 * bat * Chif
1276 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
1277 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
1278 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2)
1279 & * (chis2 * om2 * om12 - om1) / (eagle * pom)
1281 dFdL = ((dtop * bot - top * dbot) / botsq)
1283 dCAVdOM1 = dFdL * ( dFdOM1 )
1284 dCAVdOM2 = dFdL * ( dFdOM2 )
1285 dCAVdOM12 = dFdL * ( dFdOM12 )
1286 c! write (*,*) "dFcav/dOM1 = ", dCAVdOM1
1287 c! write (*,*) "dFcav/dOM2 = ", dCAVdOM2
1288 c! write (*,*) "dFcav/dOM12 = ", dCAVdOM12
1290 c!-------------------------------------------------------------------
1291 c! Finally, add the distance derivatives of GB and Fcav to gvdwc
1292 c! Pom is used here to project the gradient vector into
1293 c! cartesian coordinates and at the same time contains
1294 c! dXhb/dXsc derivative (for charged amino acids
1295 c! location of hydrophobic centre of interaction is not
1296 c! the same as geometric centre of side chain, this
1297 c! derivative takes that into account)
1298 c! derivatives of omega angles will be added in sc_grad
1301 ertail(k) = Rtail_distance(k)/Rtail
1303 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
1304 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
1305 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1306 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1308 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1309 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1310 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
1311 gvdwx(k,i) = gvdwx(k,i)
1312 & - (( dFdR + gg(k) ) * pom)
1313 c! & - ( dFdR * pom )
1314 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
1315 gvdwx(k,j) = gvdwx(k,j)
1316 & + (( dFdR + gg(k) ) * pom)
1317 c! & + ( dFdR * pom )
1319 gvdwc(k,i) = gvdwc(k,i)
1320 & - (( dFdR + gg(k) ) * ertail(k))
1321 c! & - ( dFdR * ertail(k))
1323 gvdwc(k,j) = gvdwc(k,j)
1324 & + (( dFdR + gg(k) ) * ertail(k))
1325 c! & + ( dFdR * ertail(k))
1328 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1329 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1332 c!-------------------------------------------------------------------
1333 c! Compute head-head and head-tail energies for each state
1335 isel = iabs(Qi) + iabs(Qj)
1337 c! No charges - do nothing
1340 ELSE IF (isel.eq.4) THEN
1341 c! Calculate dipole-dipole interactions
1345 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
1346 c! Charge-nonpolar interactions
1350 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
1351 c! Nonpolar-charge interactions
1355 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
1356 c! Charge-dipole interactions
1357 CALL eqd(ecl, elj, epol)
1358 eheadtail = ECL + elj + epol
1360 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
1361 c! Dipole-charge interactions
1362 CALL edq(ecl, elj, epol)
1363 eheadtail = ECL + elj + epol
1365 ELSE IF ((isel.eq.2.and.
1366 & iabs(Qi).eq.1).and.
1367 & nstate(itypi,itypj).eq.1) THEN
1368 c! Same charge-charge interaction ( +/+ or -/- )
1369 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
1370 eheadtail = ECL + Egb + Epol + Fisocav + Elj
1372 ELSE IF ((isel.eq.2.and.
1373 & iabs(Qi).eq.1).and.
1374 & nstate(itypi,itypj).ne.1) THEN
1375 c! Different charge-charge interaction ( +/- or -/+ )
1377 & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1379 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
1380 c! write (*,*) "evdw = ", evdw
1381 c! write (*,*) "Fcav = ", Fcav
1382 c! write (*,*) "eheadtail = ", eheadtail
1387 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)')
1388 & restyp(itype(i)),i,restyp(itype(j)),j,
1389 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1390 & Equad,evdwij+Fcav+eheadtail,evdw
1391 c IF (energy_dec) write (*,'(2(1x,a3,i3),3f6.2,9f16.7)')
1392 c & restyp(itype(i)),i,restyp(itype(j)),j,
1393 c & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1394 c & Equad,evdwij+Fcav+eheadtail,evdw
1400 c!-------------------------------------------------------------------
1401 c! As all angular derivatives are done, now we sum them up,
1402 c! then transform and project into cartesian vectors and add to gvdwc
1403 c! We call sc_grad always, with the exception of +/- interaction.
1404 c! This is because energy_quad subroutine needs to handle
1405 c! this job in his own way.
1406 c! This IS probably not very efficient and SHOULD be optimised
1407 c! but it will require major restructurization of emomo
1408 c! so it will be left as it is for now
1409 c! write (*,*) 'troll1, nstate =', nstate (itypi,itypj)
1410 IF (nstate(itypi,itypj).eq.1) THEN
1412 IF (bb(itypi,itypj).gt.0) THEN
1421 c!-------------------------------------------------------------------
1426 if (energy_dec) write (iout,*) "evdw before exiting emomo:",evdw
1427 c write (iout,*) "Number of loop steps in EGB:",ind
1428 c energy_dec=.false.
1430 END SUBROUTINE emomo
1434 C-----------------------------------------------------------------------------
1437 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
1439 INCLUDE 'DIMENSIONS'
1440 INCLUDE 'DIMENSIONS.ZSCOPT'
1441 INCLUDE 'COMMON.CALC'
1442 INCLUDE 'COMMON.CHAIN'
1443 INCLUDE 'COMMON.CONTROL'
1444 INCLUDE 'COMMON.DERIV'
1445 INCLUDE 'COMMON.EMP'
1446 INCLUDE 'COMMON.GEO'
1447 INCLUDE 'COMMON.INTERACT'
1448 INCLUDE 'COMMON.IOUNITS'
1449 INCLUDE 'COMMON.LOCAL'
1450 INCLUDE 'COMMON.NAMES'
1451 INCLUDE 'COMMON.VAR'
1452 double precision scalar, facd3, facd4, federmaus, adler
1453 c! Epol and Gpol analytical parameters
1454 alphapol1 = alphapol(itypi,itypj)
1455 alphapol2 = alphapol(itypj,itypi)
1456 c! Fisocav and Gisocav analytical parameters
1457 al1 = alphiso(1,itypi,itypj)
1458 al2 = alphiso(2,itypi,itypj)
1459 al3 = alphiso(3,itypi,itypj)
1460 al4 = alphiso(4,itypi,itypj)
1462 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1463 & + sigiso2(itypi,itypj)**2.0d0))
1465 pis = sig0head(itypi,itypj)
1466 eps_head = epshead(itypi,itypj)
1467 Rhead_sq = Rhead * Rhead
1468 c! R1 - distance between head of ith side chain and tail of jth sidechain
1469 c! R2 - distance between head of jth side chain and tail of ith sidechain
1473 c! Calculate head-to-tail distances needed by Epol
1474 R1=R1+(ctail(k,2)-chead(k,1))**2
1475 R2=R2+(chead(k,2)-ctail(k,1))**2
1481 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1482 c! & +dhead(1,1,itypi,itypj))**2))
1483 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1484 c! & +dhead(2,1,itypi,itypj))**2))
1486 c!-------------------------------------------------------------------
1487 c! Coulomb electrostatic interaction
1488 Ecl = (332.0d0 * Qij) / Rhead
1489 c! derivative of Ecl is Gcl...
1490 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
1494 c!-------------------------------------------------------------------
1495 c! Generalised Born Solvent Polarization
1496 c! Charged head polarizes the solvent
1497 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1498 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1499 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1500 c! Derivative of Egb is Ggb...
1501 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1502 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1504 dGGBdR = dGGBdFGB * dFGBdR
1505 c!-------------------------------------------------------------------
1506 c! Fisocav - isotropic cavity creation term
1507 c! or "how much energy it costs to put charged head in water"
1509 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1510 bot = (1.0d0 + al4 * pom**12.0d0)
1513 c! write (*,*) "Rhead = ",Rhead
1514 c! write (*,*) "csig = ",csig
1515 c! write (*,*) "pom = ",pom
1516 c! write (*,*) "al1 = ",al1
1517 c! write (*,*) "al2 = ",al2
1518 c! write (*,*) "al3 = ",al3
1519 c! write (*,*) "al4 = ",al4
1520 c! write (*,*) "top = ",top
1521 c! write (*,*) "bot = ",bot
1522 c! Derivative of Fisocav is GCV...
1523 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1524 dbot = 12.0d0 * al4 * pom ** 11.0d0
1525 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1526 c!-------------------------------------------------------------------
1528 c! Polarization energy - charged heads polarize hydrophobic "neck"
1529 MomoFac1 = (1.0d0 - chi1 * sqom2)
1530 MomoFac2 = (1.0d0 - chi2 * sqom1)
1531 RR1 = ( R1 * R1 ) / MomoFac1
1532 RR2 = ( R2 * R2 ) / MomoFac2
1533 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1534 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1535 fgb1 = sqrt( RR1 + a12sq * ee1 )
1536 fgb2 = sqrt( RR2 + a12sq * ee2 )
1537 epol = 332.0d0 * eps_inout_fac * (
1538 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1540 c write (*,*) "eps_inout_fac = ",eps_inout_fac
1541 c write (*,*) "alphapol1 = ", alphapol1
1542 c write (*,*) "alphapol2 = ", alphapol2
1543 c write (*,*) "fgb1 = ", fgb1
1544 c write (*,*) "fgb2 = ", fgb2
1545 c write (*,*) "epol = ", epol
1546 c! derivative of Epol is Gpol...
1547 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1549 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1551 dFGBdR1 = ( (R1 / MomoFac1)
1552 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1553 & / ( 2.0d0 * fgb1 )
1554 dFGBdR2 = ( (R2 / MomoFac2)
1555 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1556 & / ( 2.0d0 * fgb2 )
1557 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1558 & * ( 2.0d0 - 0.5d0 * ee1) )
1559 & / ( 2.0d0 * fgb1 )
1560 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1561 & * ( 2.0d0 - 0.5d0 * ee2) )
1562 & / ( 2.0d0 * fgb2 )
1563 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1565 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1567 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1569 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1571 c!-------------------------------------------------------------------
1573 c! Lennard-Jones 6-12 interaction between heads
1574 pom = (pis / Rhead)**6.0d0
1575 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1576 c! derivative of Elj is Glj
1577 dGLJdR = 4.0d0 * eps_head
1578 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1579 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1580 c!-------------------------------------------------------------------
1581 c! Return the results
1582 c! These things do the dRdX derivatives, that is
1583 c! allow us to change what we see from function that changes with
1584 c! distance to function that changes with LOCATION (of the interaction
1587 erhead(k) = Rhead_distance(k)/Rhead
1588 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1589 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1592 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1593 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1594 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1595 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1596 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1597 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1598 facd1 = d1 * vbld_inv(i+nres)
1599 facd2 = d2 * vbld_inv(j+nres)
1600 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1601 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1603 c! Now we add appropriate partial derivatives (one in each dimension)
1605 hawk = (erhead_tail(k,1) +
1606 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
1607 condor = (erhead_tail(k,2) +
1608 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
1610 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1611 gvdwx(k,i) = gvdwx(k,i)
1616 & - dPOLdR2 * (erhead_tail(k,2)
1617 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1620 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1621 gvdwx(k,j) = gvdwx(k,j)
1625 & + dPOLdR1 * (erhead_tail(k,1)
1626 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1627 & + dPOLdR2 * condor
1630 gvdwc(k,i) = gvdwc(k,i)
1631 & - dGCLdR * erhead(k)
1632 & - dGGBdR * erhead(k)
1633 & - dGCVdR * erhead(k)
1634 & - dPOLdR1 * erhead_tail(k,1)
1635 & - dPOLdR2 * erhead_tail(k,2)
1636 & - dGLJdR * erhead(k)
1638 gvdwc(k,j) = gvdwc(k,j)
1639 & + dGCLdR * erhead(k)
1640 & + dGGBdR * erhead(k)
1641 & + dGCVdR * erhead(k)
1642 & + dPOLdR1 * erhead_tail(k,1)
1643 & + dPOLdR2 * erhead_tail(k,2)
1644 & + dGLJdR * erhead(k)
1649 c!-------------------------------------------------------------------
1650 SUBROUTINE energy_quad
1651 &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1653 INCLUDE 'DIMENSIONS'
1654 INCLUDE 'DIMENSIONS.ZSCOPT'
1655 INCLUDE 'COMMON.CALC'
1656 INCLUDE 'COMMON.CHAIN'
1657 INCLUDE 'COMMON.CONTROL'
1658 INCLUDE 'COMMON.DERIV'
1659 INCLUDE 'COMMON.EMP'
1660 INCLUDE 'COMMON.GEO'
1661 INCLUDE 'COMMON.INTERACT'
1662 INCLUDE 'COMMON.IOUNITS'
1663 INCLUDE 'COMMON.LOCAL'
1664 INCLUDE 'COMMON.NAMES'
1665 INCLUDE 'COMMON.VAR'
1666 double precision scalar
1667 double precision ener(4)
1668 double precision dcosom1(3),dcosom2(3)
1669 c! used in Epol derivatives
1670 double precision facd3, facd4
1671 double precision federmaus, adler
1672 c! Epol and Gpol analytical parameters
1673 alphapol1 = alphapol(itypi,itypj)
1674 alphapol2 = alphapol(itypj,itypi)
1675 c! Fisocav and Gisocav analytical parameters
1676 al1 = alphiso(1,itypi,itypj)
1677 al2 = alphiso(2,itypi,itypj)
1678 al3 = alphiso(3,itypi,itypj)
1679 al4 = alphiso(4,itypi,itypj)
1681 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1682 & + sigiso2(itypi,itypj)**2.0d0))
1684 w1 = wqdip(1,itypi,itypj)
1685 w2 = wqdip(2,itypi,itypj)
1686 pis = sig0head(itypi,itypj)
1687 eps_head = epshead(itypi,itypj)
1688 c! First things first:
1689 c! We need to do sc_grad's job with GB and Fcav
1691 & eps2der * eps2rt_om1
1692 & - 2.0D0 * alf1 * eps3der
1693 & + sigder * sigsq_om1
1696 & eps2der * eps2rt_om2
1697 & + 2.0D0 * alf2 * eps3der
1698 & + sigder * sigsq_om2
1701 & evdwij * eps1_om12
1702 & + eps2der * eps2rt_om12
1703 & - 2.0D0 * alf12 * eps3der
1704 & + sigder *sigsq_om12
1706 c! now some magical transformations to project gradient into
1707 c! three cartesian vectors
1709 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1710 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1711 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
1712 c! this acts on hydrophobic center of interaction
1713 gvdwx(k,i)= gvdwx(k,i) - gg(k)
1714 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1715 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1716 gvdwx(k,j)= gvdwx(k,j) + gg(k)
1717 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1718 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1719 c! this acts on Calpha
1720 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1721 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1723 c! sc_grad is done, now we will compute
1732 c! d1 = dhead(1, 1, itypi, itypj)
1733 c! d2 = dhead(2, 1, itypi, itypj)
1734 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1735 c! & +dhead(1,ii,itypi,itypj))**2))
1736 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1737 c! & +dhead(2,jj,itypi,itypj))**2))
1738 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1739 c! END OF ENERGY DEBUG
1740 c*************************************************************
1741 DO istate = 1, nstate(itypi,itypj)
1742 c*************************************************************
1743 IF (istate.ne.1) THEN
1744 IF (istate.lt.3) THEN
1750 d1 = dhead(1,ii,itypi,itypj)
1751 d2 = dhead(2,jj,itypi,itypj)
1753 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
1754 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
1755 Rhead_distance(k) = chead(k,2) - chead(k,1)
1757 c! pitagoras (root of sum of squares)
1759 & (Rhead_distance(1)*Rhead_distance(1))
1760 & + (Rhead_distance(2)*Rhead_distance(2))
1761 & + (Rhead_distance(3)*Rhead_distance(3)))
1763 Rhead_sq = Rhead * Rhead
1765 c! R1 - distance between head of ith side chain and tail of jth sidechain
1766 c! R2 - distance between head of jth side chain and tail of ith sidechain
1770 c! Calculate head-to-tail distances
1771 R1=R1+(ctail(k,2)-chead(k,1))**2
1772 R2=R2+(chead(k,2)-ctail(k,1))**2
1779 c! write (*,*) "istate = ", istate
1780 c! write (*,*) "ii = ", ii
1781 c! write (*,*) "jj = ", jj
1782 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1783 c! & +dhead(1,ii,itypi,itypj))**2))
1784 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1785 c! & +dhead(2,jj,itypi,itypj))**2))
1786 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1787 c! Rhead_sq = Rhead * Rhead
1788 c! write (*,*) "d1 = ",d1
1789 c! write (*,*) "d2 = ",d2
1790 c! write (*,*) "R1 = ",R1
1791 c! write (*,*) "R2 = ",R2
1792 c! write (*,*) "Rhead = ",Rhead
1793 c! END OF ENERGY DEBUG
1795 c!-------------------------------------------------------------------
1796 c! Coulomb electrostatic interaction
1797 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
1799 c! write (*,*) "Ecl = ", Ecl
1800 c! derivative of Ecl is Gcl...
1801 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
1806 c!-------------------------------------------------------------------
1807 c! Generalised Born Solvent Polarization
1808 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1809 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1810 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1812 c! write (*,*) "a1*a2 = ", a12sq
1813 c! write (*,*) "Rhead = ", Rhead
1814 c! write (*,*) "Rhead_sq = ", Rhead_sq
1815 c! write (*,*) "ee = ", ee
1816 c! write (*,*) "Fgb = ", Fgb
1817 c! write (*,*) "fac = ", eps_inout_fac
1818 c! write (*,*) "Qij = ", Qij
1819 c! write (*,*) "Egb = ", Egb
1820 c! Derivative of Egb is Ggb...
1821 c! dFGBdR is used by Quad's later...
1822 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1823 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1825 dGGBdR = dGGBdFGB * dFGBdR
1827 c!-------------------------------------------------------------------
1828 c! Fisocav - isotropic cavity creation term
1830 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1831 bot = (1.0d0 + al4 * pom**12.0d0)
1835 c! write (*,*) "pom = ",pom
1836 c! write (*,*) "al1 = ",al1
1837 c! write (*,*) "al2 = ",al2
1838 c! write (*,*) "al3 = ",al3
1839 c! write (*,*) "al4 = ",al4
1840 c! write (*,*) "top = ",top
1841 c! write (*,*) "bot = ",bot
1842 c! write (*,*) "Fisocav = ", Fisocav
1844 c! Derivative of Fisocav is GCV...
1845 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1846 dbot = 12.0d0 * al4 * pom ** 11.0d0
1847 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1849 c!-------------------------------------------------------------------
1850 c! Polarization energy
1852 MomoFac1 = (1.0d0 - chi1 * sqom2)
1853 MomoFac2 = (1.0d0 - chi2 * sqom1)
1854 RR1 = ( R1 * R1 ) / MomoFac1
1855 RR2 = ( R2 * R2 ) / MomoFac2
1856 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1857 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1858 fgb1 = sqrt( RR1 + a12sq * ee1 )
1859 fgb2 = sqrt( RR2 + a12sq * ee2 )
1860 epol = 332.0d0 * eps_inout_fac * (
1861 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1863 c! derivative of Epol is Gpol...
1864 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1866 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1868 dFGBdR1 = ( (R1 / MomoFac1)
1869 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1870 & / ( 2.0d0 * fgb1 )
1871 dFGBdR2 = ( (R2 / MomoFac2)
1872 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1873 & / ( 2.0d0 * fgb2 )
1874 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1875 & * ( 2.0d0 - 0.5d0 * ee1) )
1876 & / ( 2.0d0 * fgb1 )
1877 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1878 & * ( 2.0d0 - 0.5d0 * ee2) )
1879 & / ( 2.0d0 * fgb2 )
1880 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1882 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1884 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1886 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1888 c!-------------------------------------------------------------------
1890 pom = (pis / Rhead)**6.0d0
1891 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1893 c! derivative of Elj is Glj
1894 dGLJdR = 4.0d0 * eps_head
1895 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1896 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1898 c!-------------------------------------------------------------------
1900 IF (Wqd.ne.0.0d0) THEN
1901 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0)
1902 & - 37.5d0 * ( sqom1 + sqom2 )
1903 & + 157.5d0 * ( sqom1 * sqom2 )
1904 & - 45.0d0 * om1*om2*om12
1905 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
1908 c! derivative of Equad...
1909 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
1912 & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
1913 c! dQUADdOM1 = 0.0d0
1915 & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
1916 c! dQUADdOM2 = 0.0d0
1918 & * ( 6.0d0*om12 - 45.0d0*om1*om2 )
1919 c! dQUADdOM12 = 0.0d0
1924 c!-------------------------------------------------------------------
1925 c! Return the results
1927 eom1 = dPOLdOM1 + dQUADdOM1
1928 eom2 = dPOLdOM2 + dQUADdOM2
1930 c! now some magical transformations to project gradient into
1931 c! three cartesian vectors
1933 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1934 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1935 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
1939 erhead(k) = Rhead_distance(k)/Rhead
1940 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1941 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1943 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1944 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1945 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1946 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1947 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1948 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1949 facd1 = d1 * vbld_inv(i+nres)
1950 facd2 = d2 * vbld_inv(j+nres)
1951 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1952 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1953 c! Throw the results into gheadtail which holds gradients
1954 c! for each micro-state
1956 hawk = erhead_tail(k,1) +
1957 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
1958 condor = erhead_tail(k,2) +
1959 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
1961 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1962 c! this acts on hydrophobic center of interaction
1963 gheadtail(k,1,1) = gheadtail(k,1,1)
1968 & - dPOLdR2 * (erhead_tail(k,2)
1969 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1973 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1974 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1976 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1977 c! this acts on hydrophobic center of interaction
1978 gheadtail(k,2,1) = gheadtail(k,2,1)
1982 & + dPOLdR1 * (erhead_tail(k,1)
1983 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1984 & + dPOLdR2 * condor
1988 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1989 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1991 c! this acts on Calpha
1992 gheadtail(k,3,1) = gheadtail(k,3,1)
1993 & - dGCLdR * erhead(k)
1994 & - dGGBdR * erhead(k)
1995 & - dGCVdR * erhead(k)
1996 & - dPOLdR1 * erhead_tail(k,1)
1997 & - dPOLdR2 * erhead_tail(k,2)
1998 & - dGLJdR * erhead(k)
1999 & - dQUADdR * erhead(k)
2002 c! this acts on Calpha
2003 gheadtail(k,4,1) = gheadtail(k,4,1)
2004 & + dGCLdR * erhead(k)
2005 & + dGGBdR * erhead(k)
2006 & + dGCVdR * erhead(k)
2007 & + dPOLdR1 * erhead_tail(k,1)
2008 & + dPOLdR2 * erhead_tail(k,2)
2009 & + dGLJdR * erhead(k)
2010 & + dQUADdR * erhead(k)
2013 c! write(*,*) "ECL = ", Ecl
2014 c! write(*,*) "Egb = ", Egb
2015 c! write(*,*) "Epol = ", Epol
2016 c! write(*,*) "Fisocav = ", Fisocav
2017 c! write(*,*) "Elj = ", Elj
2018 c! write(*,*) "Equad = ", Equad
2019 c! write(*,*) "wstate = ", wstate(istate,itypi,itypj)
2020 c! write(*,*) "eheadtail = ", eheadtail
2021 c! write(*,*) "TROLL = ", dexp(-betaT * ener(istate))
2022 c! write(*,*) "dGCLdR = ", dGCLdR
2023 c! write(*,*) "dGGBdR = ", dGGBdR
2024 c! write(*,*) "dGCVdR = ", dGCVdR
2025 c! write(*,*) "dPOLdR1 = ", dPOLdR1
2026 c! write(*,*) "dPOLdR2 = ", dPOLdR2
2027 c! write(*,*) "dGLJdR = ", dGLJdR
2028 c! write(*,*) "dQUADdR = ", dQUADdR
2029 c! write(*,*) "tuna(",k,") = ", tuna(k)
2030 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
2031 eheadtail = eheadtail
2032 & + wstate(istate, itypi, itypj)
2033 & * dexp(-betaT * ener(istate))
2034 c! foreach cartesian dimension
2036 c! foreach of two gvdwx and gvdwc
2038 gheadtail(k,l,2) = gheadtail(k,l,2)
2039 & + wstate( istate, itypi, itypj )
2040 & * dexp(-betaT * ener(istate))
2041 & * gheadtail(k,l,1)
2042 gheadtail(k,l,1) = 0.0d0
2046 c! Here ended the gigantic DO istate = 1, 4, which starts
2047 c! at the beggining of the subroutine
2051 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
2053 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
2054 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
2055 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
2056 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
2058 gheadtail(k,l,1) = 0.0d0
2059 gheadtail(k,l,2) = 0.0d0
2062 eheadtail = (-dlog(eheadtail)) / betaT
2069 END SUBROUTINE energy_quad
2072 c!-------------------------------------------------------------------
2075 SUBROUTINE eqn(Epol)
2077 INCLUDE 'DIMENSIONS'
2078 INCLUDE 'DIMENSIONS.ZSCOPT'
2079 INCLUDE 'COMMON.CALC'
2080 INCLUDE 'COMMON.CHAIN'
2081 INCLUDE 'COMMON.CONTROL'
2082 INCLUDE 'COMMON.DERIV'
2083 INCLUDE 'COMMON.EMP'
2084 INCLUDE 'COMMON.GEO'
2085 INCLUDE 'COMMON.INTERACT'
2086 INCLUDE 'COMMON.IOUNITS'
2087 INCLUDE 'COMMON.LOCAL'
2088 INCLUDE 'COMMON.NAMES'
2089 INCLUDE 'COMMON.VAR'
2090 double precision scalar, facd4, federmaus
2091 alphapol1 = alphapol(itypi,itypj)
2092 c! R1 - distance between head of ith side chain and tail of jth sidechain
2095 c! Calculate head-to-tail distances
2096 R1=R1+(ctail(k,2)-chead(k,1))**2
2101 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2102 c! & +dhead(1,1,itypi,itypj))**2))
2103 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2104 c! & +dhead(2,1,itypi,itypj))**2))
2105 c--------------------------------------------------------------------
2106 c Polarization energy
2108 MomoFac1 = (1.0d0 - chi1 * sqom2)
2109 RR1 = R1 * R1 / MomoFac1
2110 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2111 fgb1 = sqrt( RR1 + a12sq * ee1)
2112 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2114 c!------------------------------------------------------------------
2115 c! derivative of Epol is Gpol...
2116 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2118 dFGBdR1 = ( (R1 / MomoFac1)
2119 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2120 & / ( 2.0d0 * fgb1 )
2121 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2122 & * (2.0d0 - 0.5d0 * ee1) )
2124 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2127 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2129 c!-------------------------------------------------------------------
2130 c! Return the results
2131 c! (see comments in Eqq)
2133 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2135 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2136 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2137 facd1 = d1 * vbld_inv(i+nres)
2138 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2141 hawk = (erhead_tail(k,1) +
2142 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2144 gvdwx(k,i) = gvdwx(k,i)
2146 gvdwx(k,j) = gvdwx(k,j)
2147 & + dPOLdR1 * (erhead_tail(k,1)
2148 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2150 gvdwc(k,i) = gvdwc(k,i)
2151 & - dPOLdR1 * erhead_tail(k,1)
2152 gvdwc(k,j) = gvdwc(k,j)
2153 & + dPOLdR1 * erhead_tail(k,1)
2160 c!-------------------------------------------------------------------
2164 SUBROUTINE enq(Epol)
2166 INCLUDE 'DIMENSIONS'
2167 INCLUDE 'DIMENSIONS.ZSCOPT'
2168 INCLUDE 'COMMON.CALC'
2169 INCLUDE 'COMMON.CHAIN'
2170 INCLUDE 'COMMON.CONTROL'
2171 INCLUDE 'COMMON.DERIV'
2172 INCLUDE 'COMMON.EMP'
2173 INCLUDE 'COMMON.GEO'
2174 INCLUDE 'COMMON.INTERACT'
2175 INCLUDE 'COMMON.IOUNITS'
2176 INCLUDE 'COMMON.LOCAL'
2177 INCLUDE 'COMMON.NAMES'
2178 INCLUDE 'COMMON.VAR'
2179 double precision scalar, facd3, adler
2180 alphapol2 = alphapol(itypj,itypi)
2181 c! R2 - distance between head of jth side chain and tail of ith sidechain
2184 c! Calculate head-to-tail distances
2185 R2=R2+(chead(k,2)-ctail(k,1))**2
2190 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2191 c! & +dhead(1,1,itypi,itypj))**2))
2192 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2193 c! & +dhead(2,1,itypi,itypj))**2))
2194 c------------------------------------------------------------------------
2195 c Polarization energy
2196 MomoFac2 = (1.0d0 - chi2 * sqom1)
2197 RR2 = R2 * R2 / MomoFac2
2198 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2199 fgb2 = sqrt(RR2 + a12sq * ee2)
2200 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2202 c!-------------------------------------------------------------------
2203 c! derivative of Epol is Gpol...
2204 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2206 dFGBdR2 = ( (R2 / MomoFac2)
2207 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2209 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2210 & * (2.0d0 - 0.5d0 * ee2) )
2212 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2214 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2217 c!-------------------------------------------------------------------
2218 c! Return the results
2219 c! (See comments in Eqq)
2221 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2223 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2224 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2225 facd2 = d2 * vbld_inv(j+nres)
2226 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2228 condor = (erhead_tail(k,2)
2229 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2231 gvdwx(k,i) = gvdwx(k,i)
2232 & - dPOLdR2 * (erhead_tail(k,2)
2233 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2234 gvdwx(k,j) = gvdwx(k,j)
2235 & + dPOLdR2 * condor
2237 gvdwc(k,i) = gvdwc(k,i)
2238 & - dPOLdR2 * erhead_tail(k,2)
2239 gvdwc(k,j) = gvdwc(k,j)
2240 & + dPOLdR2 * erhead_tail(k,2)
2247 c!-------------------------------------------------------------------
2250 SUBROUTINE eqd(Ecl,Elj,Epol)
2252 INCLUDE 'DIMENSIONS'
2253 INCLUDE 'DIMENSIONS.ZSCOPT'
2254 INCLUDE 'COMMON.CALC'
2255 INCLUDE 'COMMON.CHAIN'
2256 INCLUDE 'COMMON.CONTROL'
2257 INCLUDE 'COMMON.DERIV'
2258 INCLUDE 'COMMON.EMP'
2259 INCLUDE 'COMMON.GEO'
2260 INCLUDE 'COMMON.INTERACT'
2261 INCLUDE 'COMMON.IOUNITS'
2262 INCLUDE 'COMMON.LOCAL'
2263 INCLUDE 'COMMON.NAMES'
2264 INCLUDE 'COMMON.VAR'
2265 double precision scalar, facd4, federmaus
2266 alphapol1 = alphapol(itypi,itypj)
2267 w1 = wqdip(1,itypi,itypj)
2268 w2 = wqdip(2,itypi,itypj)
2269 pis = sig0head(itypi,itypj)
2270 eps_head = epshead(itypi,itypj)
2271 c!-------------------------------------------------------------------
2272 c! R1 - distance between head of ith side chain and tail of jth sidechain
2275 c! Calculate head-to-tail distances
2276 R1=R1+(ctail(k,2)-chead(k,1))**2
2281 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2282 c! & +dhead(1,1,itypi,itypj))**2))
2283 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2284 c! & +dhead(2,1,itypi,itypj))**2))
2286 c!-------------------------------------------------------------------
2288 sparrow = w1 * Qi * om1
2289 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2290 Ecl = sparrow / Rhead**2.0d0
2291 & - hawk / Rhead**4.0d0
2292 c!-------------------------------------------------------------------
2293 c! derivative of ecl is Gcl
2295 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2296 & + 4.0d0 * hawk / Rhead**5.0d0
2298 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2300 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2301 c--------------------------------------------------------------------
2302 c Polarization energy
2304 MomoFac1 = (1.0d0 - chi1 * sqom2)
2305 RR1 = R1 * R1 / MomoFac1
2306 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2307 fgb1 = sqrt( RR1 + a12sq * ee1)
2308 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2310 c!------------------------------------------------------------------
2311 c! derivative of Epol is Gpol...
2312 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2314 dFGBdR1 = ( (R1 / MomoFac1)
2315 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2316 & / ( 2.0d0 * fgb1 )
2317 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2318 & * (2.0d0 - 0.5d0 * ee1) )
2320 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2323 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2325 c!-------------------------------------------------------------------
2327 pom = (pis / Rhead)**6.0d0
2328 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2329 c! derivative of Elj is Glj
2330 dGLJdR = 4.0d0 * eps_head
2331 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2332 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2333 c!-------------------------------------------------------------------
2334 c! Return the results
2336 erhead(k) = Rhead_distance(k)/Rhead
2337 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2340 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2341 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2342 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2343 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2344 facd1 = d1 * vbld_inv(i+nres)
2345 facd2 = d2 * vbld_inv(j+nres)
2346 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2349 hawk = (erhead_tail(k,1) +
2350 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2352 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2353 gvdwx(k,i) = gvdwx(k,i)
2358 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2359 gvdwx(k,j) = gvdwx(k,j)
2361 & + dPOLdR1 * (erhead_tail(k,1)
2362 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2366 gvdwc(k,i) = gvdwc(k,i)
2367 & - dGCLdR * erhead(k)
2368 & - dPOLdR1 * erhead_tail(k,1)
2369 & - dGLJdR * erhead(k)
2371 gvdwc(k,j) = gvdwc(k,j)
2372 & + dGCLdR * erhead(k)
2373 & + dPOLdR1 * erhead_tail(k,1)
2374 & + dGLJdR * erhead(k)
2381 c!-------------------------------------------------------------------
2384 SUBROUTINE edq(Ecl,Elj,Epol)
2386 INCLUDE 'DIMENSIONS'
2387 INCLUDE 'DIMENSIONS.ZSCOPT'
2388 INCLUDE 'COMMON.CALC'
2389 INCLUDE 'COMMON.CHAIN'
2390 INCLUDE 'COMMON.CONTROL'
2391 INCLUDE 'COMMON.DERIV'
2392 INCLUDE 'COMMON.EMP'
2393 INCLUDE 'COMMON.GEO'
2394 INCLUDE 'COMMON.INTERACT'
2395 INCLUDE 'COMMON.IOUNITS'
2396 INCLUDE 'COMMON.LOCAL'
2397 INCLUDE 'COMMON.NAMES'
2398 INCLUDE 'COMMON.VAR'
2399 double precision scalar, facd3, adler
2400 alphapol2 = alphapol(itypj,itypi)
2401 w1 = wqdip(1,itypi,itypj)
2402 w2 = wqdip(2,itypi,itypj)
2403 pis = sig0head(itypi,itypj)
2404 eps_head = epshead(itypi,itypj)
2405 c!-------------------------------------------------------------------
2406 c! R2 - distance between head of jth side chain and tail of ith sidechain
2409 c! Calculate head-to-tail distances
2410 R2=R2+(chead(k,2)-ctail(k,1))**2
2415 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2416 c! & +dhead(1,1,itypi,itypj))**2))
2417 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2418 c! & +dhead(2,1,itypi,itypj))**2))
2421 c!-------------------------------------------------------------------
2423 sparrow = w1 * Qi * om1
2424 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2425 ECL = sparrow / Rhead**2.0d0
2426 & - hawk / Rhead**4.0d0
2427 c!-------------------------------------------------------------------
2428 c! derivative of ecl is Gcl
2430 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2431 & + 4.0d0 * hawk / Rhead**5.0d0
2433 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2435 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2436 c--------------------------------------------------------------------
2437 c Polarization energy
2439 MomoFac2 = (1.0d0 - chi2 * sqom1)
2440 RR2 = R2 * R2 / MomoFac2
2441 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2442 fgb2 = sqrt(RR2 + a12sq * ee2)
2443 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2445 c! derivative of Epol is Gpol...
2446 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2448 dFGBdR2 = ( (R2 / MomoFac2)
2449 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2451 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2452 & * (2.0d0 - 0.5d0 * ee2) )
2454 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2456 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2459 c!-------------------------------------------------------------------
2461 pom = (pis / Rhead)**6.0d0
2462 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2463 c! derivative of Elj is Glj
2464 dGLJdR = 4.0d0 * eps_head
2465 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2466 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2467 c!-------------------------------------------------------------------
2468 c! Return the results
2469 c! (see comments in Eqq)
2471 erhead(k) = Rhead_distance(k)/Rhead
2472 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2474 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2475 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2476 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2477 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2478 facd1 = d1 * vbld_inv(i+nres)
2479 facd2 = d2 * vbld_inv(j+nres)
2480 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2483 condor = (erhead_tail(k,2)
2484 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2486 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2487 gvdwx(k,i) = gvdwx(k,i)
2489 & - dPOLdR2 * (erhead_tail(k,2)
2490 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2493 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2494 gvdwx(k,j) = gvdwx(k,j)
2496 & + dPOLdR2 * condor
2500 gvdwc(k,i) = gvdwc(k,i)
2501 & - dGCLdR * erhead(k)
2502 & - dPOLdR2 * erhead_tail(k,2)
2503 & - dGLJdR * erhead(k)
2505 gvdwc(k,j) = gvdwc(k,j)
2506 & + dGCLdR * erhead(k)
2507 & + dPOLdR2 * erhead_tail(k,2)
2508 & + dGLJdR * erhead(k)
2515 C--------------------------------------------------------------------
2520 INCLUDE 'DIMENSIONS'
2521 INCLUDE 'DIMENSIONS.ZSCOPT'
2522 INCLUDE 'COMMON.CALC'
2523 INCLUDE 'COMMON.CHAIN'
2524 INCLUDE 'COMMON.CONTROL'
2525 INCLUDE 'COMMON.DERIV'
2526 INCLUDE 'COMMON.EMP'
2527 INCLUDE 'COMMON.GEO'
2528 INCLUDE 'COMMON.INTERACT'
2529 INCLUDE 'COMMON.IOUNITS'
2530 INCLUDE 'COMMON.LOCAL'
2531 INCLUDE 'COMMON.NAMES'
2532 INCLUDE 'COMMON.VAR'
2533 double precision scalar
2534 c! csig = sigiso(itypi,itypj)
2535 w1 = wqdip(1,itypi,itypj)
2536 w2 = wqdip(2,itypi,itypj)
2537 c!-------------------------------------------------------------------
2539 fac = (om12 - 3.0d0 * om1 * om2)
2540 c1 = (w1 / (Rhead**3.0d0)) * fac
2541 c2 = (w2 / Rhead ** 6.0d0)
2542 & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2544 c! write (*,*) "w1 = ", w1
2545 c! write (*,*) "w2 = ", w2
2546 c! write (*,*) "om1 = ", om1
2547 c! write (*,*) "om2 = ", om2
2548 c! write (*,*) "om12 = ", om12
2549 c! write (*,*) "fac = ", fac
2550 c! write (*,*) "c1 = ", c1
2551 c! write (*,*) "c2 = ", c2
2552 c! write (*,*) "Ecl = ", Ecl
2553 c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
2554 c! write (*,*) "c2_2 = ",
2555 c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2556 c!-------------------------------------------------------------------
2557 c! dervative of ECL is GCL...
2559 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
2560 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0)
2561 & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
2564 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
2565 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2566 & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
2569 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
2570 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2571 & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
2574 c1 = w1 / (Rhead ** 3.0d0)
2575 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
2577 c!-------------------------------------------------------------------
2578 c! Return the results
2579 c! (see comments in Eqq)
2581 erhead(k) = Rhead_distance(k)/Rhead
2583 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2584 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2585 facd1 = d1 * vbld_inv(i+nres)
2586 facd2 = d2 * vbld_inv(j+nres)
2589 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2590 gvdwx(k,i) = gvdwx(k,i)
2592 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2593 gvdwx(k,j) = gvdwx(k,j)
2596 gvdwc(k,i) = gvdwc(k,i)
2597 & - dGCLdR * erhead(k)
2598 gvdwc(k,j) = gvdwc(k,j)
2599 & + dGCLdR * erhead(k)
2605 c!-------------------------------------------------------------------
2608 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
2611 INCLUDE 'DIMENSIONS'
2612 c! itypi, itypj, i, j, k, l, chead,
2613 INCLUDE 'COMMON.CALC'
2615 INCLUDE 'COMMON.CHAIN'
2617 INCLUDE 'COMMON.DERIV'
2618 c! electrostatic gradients-specific variables
2619 INCLUDE 'COMMON.EMP'
2620 c! wquad, dhead, alphiso, alphasur, rborn, epsintab
2621 INCLUDE 'COMMON.INTERACT'
2622 c! io for debug, disable it in final builds
2623 INCLUDE 'COMMON.IOUNITS'
2624 c!-------------------------------------------------------------------
2627 c! what amino acid is the aminoacid j'th?
2629 c! 1/(Gas Constant * Thermostate temperature) = BetaT
2630 c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
2631 BetaT = 1.0d0 / (298 * 1.987d-3)
2633 sig0ij = sigma( itypi,itypj )
2634 chi1 = chi( itypi, itypj )
2635 chi2 = chi( itypj, itypi )
2637 chip1 = chipp( itypi, itypj )
2638 chip2 = chipp( itypj, itypi )
2639 chip12 = chip1 * chip2
2640 c! write (2,*) "elgrad types",itypi,itypj,
2641 c! & " chi1",chi1," chi2",chi2," chi12",chi12,
2642 c! & " chip1",chip1," chip2",chip2," chip12",chip12
2643 c! not used by momo potential, but needed by sc_angular which is shared
2644 c! by all energy_potential subroutines
2648 c! location, location, location
2649 xj = c( 1, nres+j ) - xi
2650 yj = c( 2, nres+j ) - yi
2651 zj = c( 3, nres+j ) - zi
2652 dxj = dc_norm( 1, nres+j )
2653 dyj = dc_norm( 2, nres+j )
2654 dzj = dc_norm( 3, nres+j )
2655 c! distance from center of chain(?) to polar/charged head
2656 c! write (*,*) "istate = ", 1
2657 c! write (*,*) "ii = ", 1
2658 c! write (*,*) "jj = ", 1
2659 d1 = dhead(1, 1, itypi, itypj)
2660 d2 = dhead(2, 1, itypi, itypj)
2662 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
2663 c! a12sq = a12sq * a12sq
2664 c! charge of amino acid itypi is...
2669 chis1 = chis(itypi,itypj)
2670 chis2 = chis(itypj,itypi)
2671 chis12 = chis1 * chis2
2672 sig1 = sigmap1(itypi,itypj)
2673 sig2 = sigmap2(itypi,itypj)
2674 c! write (*,*) "sig1 = ", sig1
2675 c! write (*,*) "sig2 = ", sig2
2676 c! alpha factors from Fcav/Gcav
2677 b1 = alphasur(1,itypi,itypj)
2678 b2 = alphasur(2,itypi,itypj)
2679 b3 = alphasur(3,itypi,itypj)
2680 b4 = alphasur(4,itypi,itypj)
2681 c! used to determine whether we want to do quadrupole calculations
2682 wqd = wquad(itypi, itypj)
2684 eps_in = epsintab(itypi,itypj)
2685 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
2686 c! write (*,*) "eps_inout_fac = ", eps_inout_fac
2687 c!-------------------------------------------------------------------
2688 c! tail location and distance calculations
2691 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
2692 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
2694 c! tail distances will be themselves usefull elswhere
2695 c1 (in Gcav, for example)
2696 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
2697 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
2698 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
2700 & (Rtail_distance(1)*Rtail_distance(1))
2701 & + (Rtail_distance(2)*Rtail_distance(2))
2702 & + (Rtail_distance(3)*Rtail_distance(3)))
2703 c!-------------------------------------------------------------------
2704 c! Calculate location and distance between polar heads
2705 c! distance between heads
2706 c! for each one of our three dimensional space...
2708 c! location of polar head is computed by taking hydrophobic centre
2709 c! and moving by a d1 * dc_norm vector
2710 c! see unres publications for very informative images
2711 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
2712 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
2714 c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
2715 c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
2716 Rhead_distance(k) = chead(k,2) - chead(k,1)
2718 c! pitagoras (root of sum of squares)
2720 & (Rhead_distance(1)*Rhead_distance(1))
2721 & + (Rhead_distance(2)*Rhead_distance(2))
2722 & + (Rhead_distance(3)*Rhead_distance(3)))
2723 c!-------------------------------------------------------------------
2724 c! zero everything that should be zero'ed
2737 END SUBROUTINE elgrad_init
2738 c!-------------------------------------------------------------------
2739 subroutine sc_angular
2740 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2741 C om12. Called by ebp, egb, and egbv.
2743 include 'COMMON.CALC'
2744 include 'COMMON.IOUNITS'
2748 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2749 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2750 om12=dxi*dxj+dyi*dyj+dzi*dzj
2755 C Calculate eps1(om12) and its derivative in om12
2756 faceps1=1.0D0-om12*chiom12
2757 faceps1_inv=1.0D0/faceps1
2758 eps1=dsqrt(faceps1_inv)
2759 c write (2,*) "chi1",chi1," chi2",chi2," chi12",chi12
2760 c write (2,*) "fsceps1",faceps1," faceps1_inv",faceps1_inv,
2762 C Following variable is eps1*deps1/dom12
2763 eps1_om12=faceps1_inv*chiom12
2768 c write (iout,*) "om12",om12," eps1",eps1
2769 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2774 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2775 sigsq=1.0D0-facsig*faceps1_inv
2776 c write (2,*) "om1",om1," om2",om2," om1om2",om1om2,
2777 c & " chiom1",chiom1,
2778 c & " chiom2",chiom2," facsig",facsig," sigsq",sigsq
2779 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2780 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2781 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2787 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2788 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2790 C Calculate eps2 and its derivatives in om1, om2, and om12.
2793 chipom12=chip12*om12
2794 facp=1.0D0-om12*chipom12
2796 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2797 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2798 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2799 C Following variable is the square root of eps2
2800 eps2rt=1.0D0-facp1*facp_inv
2801 C Following three variables are the derivatives of the square root of eps
2802 C in om1, om2, and om12.
2803 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2804 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2805 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2806 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2807 c! Note that THIS is 0 in emomo, so we should probably move it out of sc_angular
2808 c! Or frankly, we should restructurize the whole energy section
2809 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2810 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2811 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2812 c & " eps2rt_om12",eps2rt_om12
2813 C Calculate whole angle-dependent part of epsilon and contributions
2814 C to its derivatives
2817 C----------------------------------------------------------------------------
2819 implicit real*8 (a-h,o-z)
2820 include 'DIMENSIONS'
2821 include 'DIMENSIONS.ZSCOPT'
2822 include 'COMMON.CHAIN'
2823 include 'COMMON.DERIV'
2824 include 'COMMON.CALC'
2825 double precision dcosom1(3),dcosom2(3)
2826 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2827 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2828 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2829 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2831 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2832 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2835 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2838 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2839 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2840 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2841 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2842 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2843 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2846 C Calculate the components of the gradient in DC and X
2850 gvdwc(l,k)=gvdwc(l,k)+gg(l)
2855 c------------------------------------------------------------------------------
2856 subroutine vec_and_deriv
2857 implicit real*8 (a-h,o-z)
2858 include 'DIMENSIONS'
2859 include 'DIMENSIONS.ZSCOPT'
2860 include 'COMMON.IOUNITS'
2861 include 'COMMON.GEO'
2862 include 'COMMON.VAR'
2863 include 'COMMON.LOCAL'
2864 include 'COMMON.CHAIN'
2865 include 'COMMON.VECTORS'
2866 include 'COMMON.DERIV'
2867 include 'COMMON.INTERACT'
2868 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2869 C Compute the local reference systems. For reference system (i), the
2870 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2871 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2873 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
2874 if (i.eq.nres-1) then
2875 C Case of the last full residue
2876 C Compute the Z-axis
2877 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2878 costh=dcos(pi-theta(nres))
2879 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2884 C Compute the derivatives of uz
2886 uzder(2,1,1)=-dc_norm(3,i-1)
2887 uzder(3,1,1)= dc_norm(2,i-1)
2888 uzder(1,2,1)= dc_norm(3,i-1)
2890 uzder(3,2,1)=-dc_norm(1,i-1)
2891 uzder(1,3,1)=-dc_norm(2,i-1)
2892 uzder(2,3,1)= dc_norm(1,i-1)
2895 uzder(2,1,2)= dc_norm(3,i)
2896 uzder(3,1,2)=-dc_norm(2,i)
2897 uzder(1,2,2)=-dc_norm(3,i)
2899 uzder(3,2,2)= dc_norm(1,i)
2900 uzder(1,3,2)= dc_norm(2,i)
2901 uzder(2,3,2)=-dc_norm(1,i)
2904 C Compute the Y-axis
2907 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2910 C Compute the derivatives of uy
2913 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2914 & -dc_norm(k,i)*dc_norm(j,i-1)
2915 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2917 uyder(j,j,1)=uyder(j,j,1)-costh
2918 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2923 uygrad(l,k,j,i)=uyder(l,k,j)
2924 uzgrad(l,k,j,i)=uzder(l,k,j)
2928 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2929 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2930 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2931 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2935 C Compute the Z-axis
2936 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2937 costh=dcos(pi-theta(i+2))
2938 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2943 C Compute the derivatives of uz
2945 uzder(2,1,1)=-dc_norm(3,i+1)
2946 uzder(3,1,1)= dc_norm(2,i+1)
2947 uzder(1,2,1)= dc_norm(3,i+1)
2949 uzder(3,2,1)=-dc_norm(1,i+1)
2950 uzder(1,3,1)=-dc_norm(2,i+1)
2951 uzder(2,3,1)= dc_norm(1,i+1)
2954 uzder(2,1,2)= dc_norm(3,i)
2955 uzder(3,1,2)=-dc_norm(2,i)
2956 uzder(1,2,2)=-dc_norm(3,i)
2958 uzder(3,2,2)= dc_norm(1,i)
2959 uzder(1,3,2)= dc_norm(2,i)
2960 uzder(2,3,2)=-dc_norm(1,i)
2963 C Compute the Y-axis
2966 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2969 C Compute the derivatives of uy
2972 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2973 & -dc_norm(k,i)*dc_norm(j,i+1)
2974 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2976 uyder(j,j,1)=uyder(j,j,1)-costh
2977 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2982 uygrad(l,k,j,i)=uyder(l,k,j)
2983 uzgrad(l,k,j,i)=uzder(l,k,j)
2987 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2988 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2989 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2990 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2996 vbld_inv_temp(1)=vbld_inv(i+1)
2997 if (i.lt.nres-1) then
2998 vbld_inv_temp(2)=vbld_inv(i+2)
3000 vbld_inv_temp(2)=vbld_inv(i)
3005 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
3006 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
3014 C-----------------------------------------------------------------------------
3015 subroutine vec_and_deriv_test
3016 implicit real*8 (a-h,o-z)
3017 include 'DIMENSIONS'
3018 include 'DIMENSIONS.ZSCOPT'
3019 include 'COMMON.IOUNITS'
3020 include 'COMMON.GEO'
3021 include 'COMMON.VAR'
3022 include 'COMMON.LOCAL'
3023 include 'COMMON.CHAIN'
3024 include 'COMMON.VECTORS'
3025 dimension uyder(3,3,2),uzder(3,3,2)
3026 C Compute the local reference systems. For reference system (i), the
3027 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
3028 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
3030 if (i.eq.nres-1) then
3031 C Case of the last full residue
3032 C Compute the Z-axis
3033 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
3034 costh=dcos(pi-theta(nres))
3035 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3036 c write (iout,*) 'fac',fac,
3037 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
3038 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
3042 C Compute the derivatives of uz
3044 uzder(2,1,1)=-dc_norm(3,i-1)
3045 uzder(3,1,1)= dc_norm(2,i-1)
3046 uzder(1,2,1)= dc_norm(3,i-1)
3048 uzder(3,2,1)=-dc_norm(1,i-1)
3049 uzder(1,3,1)=-dc_norm(2,i-1)
3050 uzder(2,3,1)= dc_norm(1,i-1)
3053 uzder(2,1,2)= dc_norm(3,i)
3054 uzder(3,1,2)=-dc_norm(2,i)
3055 uzder(1,2,2)=-dc_norm(3,i)
3057 uzder(3,2,2)= dc_norm(1,i)
3058 uzder(1,3,2)= dc_norm(2,i)
3059 uzder(2,3,2)=-dc_norm(1,i)
3061 C Compute the Y-axis
3063 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
3066 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
3067 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
3068 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
3070 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
3073 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
3074 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
3077 c write (iout,*) 'facy',facy,
3078 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3079 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3081 uy(k,i)=facy*uy(k,i)
3083 C Compute the derivatives of uy
3086 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
3087 & -dc_norm(k,i)*dc_norm(j,i-1)
3088 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3090 c uyder(j,j,1)=uyder(j,j,1)-costh
3091 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
3092 uyder(j,j,1)=uyder(j,j,1)
3093 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
3094 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
3100 uygrad(l,k,j,i)=uyder(l,k,j)
3101 uzgrad(l,k,j,i)=uzder(l,k,j)
3105 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3106 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3107 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3108 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3111 C Compute the Z-axis
3112 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
3113 costh=dcos(pi-theta(i+2))
3114 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3115 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
3119 C Compute the derivatives of uz
3121 uzder(2,1,1)=-dc_norm(3,i+1)
3122 uzder(3,1,1)= dc_norm(2,i+1)
3123 uzder(1,2,1)= dc_norm(3,i+1)
3125 uzder(3,2,1)=-dc_norm(1,i+1)
3126 uzder(1,3,1)=-dc_norm(2,i+1)
3127 uzder(2,3,1)= dc_norm(1,i+1)
3130 uzder(2,1,2)= dc_norm(3,i)
3131 uzder(3,1,2)=-dc_norm(2,i)
3132 uzder(1,2,2)=-dc_norm(3,i)
3134 uzder(3,2,2)= dc_norm(1,i)
3135 uzder(1,3,2)= dc_norm(2,i)
3136 uzder(2,3,2)=-dc_norm(1,i)
3138 C Compute the Y-axis
3140 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
3141 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
3142 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
3144 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
3147 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
3148 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
3151 c write (iout,*) 'facy',facy,
3152 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3153 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3155 uy(k,i)=facy*uy(k,i)
3157 C Compute the derivatives of uy
3160 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
3161 & -dc_norm(k,i)*dc_norm(j,i+1)
3162 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3164 c uyder(j,j,1)=uyder(j,j,1)-costh
3165 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
3166 uyder(j,j,1)=uyder(j,j,1)
3167 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
3168 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
3174 uygrad(l,k,j,i)=uyder(l,k,j)
3175 uzgrad(l,k,j,i)=uzder(l,k,j)
3179 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3180 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3181 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3182 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3189 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
3190 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
3197 C-----------------------------------------------------------------------------
3198 subroutine check_vecgrad
3199 implicit real*8 (a-h,o-z)
3200 include 'DIMENSIONS'
3201 include 'DIMENSIONS.ZSCOPT'
3202 include 'COMMON.IOUNITS'
3203 include 'COMMON.GEO'
3204 include 'COMMON.VAR'
3205 include 'COMMON.LOCAL'
3206 include 'COMMON.CHAIN'
3207 include 'COMMON.VECTORS'
3208 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
3209 dimension uyt(3,maxres),uzt(3,maxres)
3210 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
3211 double precision delta /1.0d-7/
3214 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
3215 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
3216 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
3217 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
3218 cd & (dc_norm(if90,i),if90=1,3)
3219 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
3220 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
3221 cd write(iout,'(a)')
3227 uygradt(l,k,j,i)=uygrad(l,k,j,i)
3228 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
3241 cd write (iout,*) 'i=',i
3243 erij(k)=dc_norm(k,i)
3247 dc_norm(k,i)=erij(k)
3249 dc_norm(j,i)=dc_norm(j,i)+delta
3250 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
3252 c dc_norm(k,i)=dc_norm(k,i)/fac
3254 c write (iout,*) (dc_norm(k,i),k=1,3)
3255 c write (iout,*) (erij(k),k=1,3)
3258 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
3259 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
3260 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
3261 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
3263 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3264 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
3265 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
3268 dc_norm(k,i)=erij(k)
3271 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3272 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
3273 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
3274 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3275 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
3276 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
3277 cd write (iout,'(a)')
3282 C--------------------------------------------------------------------------
3283 subroutine set_matrices
3284 implicit real*8 (a-h,o-z)
3285 include 'DIMENSIONS'
3286 include 'DIMENSIONS.ZSCOPT'
3287 include 'COMMON.IOUNITS'
3288 include 'COMMON.GEO'
3289 include 'COMMON.VAR'
3290 include 'COMMON.LOCAL'
3291 include 'COMMON.CHAIN'
3292 include 'COMMON.DERIV'
3293 include 'COMMON.INTERACT'
3294 include 'COMMON.CONTACTS'
3295 include 'COMMON.TORSION'
3296 include 'COMMON.VECTORS'
3297 include 'COMMON.FFIELD'
3298 double precision auxvec(2),auxmat(2,2)
3300 C Compute the virtual-bond-torsional-angle dependent quantities needed
3301 C to calculate the el-loc multibody terms of various order.
3304 if (i .lt. nres+1) then
3341 if (i .gt. 3 .and. i .lt. nres+1) then
3342 obrot_der(1,i-2)=-sin1
3343 obrot_der(2,i-2)= cos1
3344 Ugder(1,1,i-2)= sin1
3345 Ugder(1,2,i-2)=-cos1
3346 Ugder(2,1,i-2)=-cos1
3347 Ugder(2,2,i-2)=-sin1
3350 obrot2_der(1,i-2)=-dwasin2
3351 obrot2_der(2,i-2)= dwacos2
3352 Ug2der(1,1,i-2)= dwasin2
3353 Ug2der(1,2,i-2)=-dwacos2
3354 Ug2der(2,1,i-2)=-dwacos2
3355 Ug2der(2,2,i-2)=-dwasin2
3357 obrot_der(1,i-2)=0.0d0
3358 obrot_der(2,i-2)=0.0d0
3359 Ugder(1,1,i-2)=0.0d0
3360 Ugder(1,2,i-2)=0.0d0
3361 Ugder(2,1,i-2)=0.0d0
3362 Ugder(2,2,i-2)=0.0d0
3363 obrot2_der(1,i-2)=0.0d0
3364 obrot2_der(2,i-2)=0.0d0
3365 Ug2der(1,1,i-2)=0.0d0
3366 Ug2der(1,2,i-2)=0.0d0
3367 Ug2der(2,1,i-2)=0.0d0
3368 Ug2der(2,2,i-2)=0.0d0
3370 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
3371 iti = itortyp(itype(i-2))
3375 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3376 iti1 = itortyp(itype(i-1))
3380 cd write (iout,*) '*******i',i,' iti1',iti
3381 cd write (iout,*) 'b1',b1(:,iti)
3382 cd write (iout,*) 'b2',b2(:,iti)
3383 cd write (iout,*) 'Ug',Ug(:,:,i-2)
3384 if (i .gt. iatel_s+2) then
3385 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
3386 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
3387 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
3388 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
3389 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3390 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
3391 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
3401 DtUg2(l,k,i-2)=0.0d0
3405 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
3406 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
3407 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3408 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3409 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3410 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3411 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3413 muder(k,i-2)=Ub2der(k,i-2)
3415 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3416 iti1 = itortyp(itype(i-1))
3421 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
3423 C Vectors and matrices dependent on a single virtual-bond dihedral.
3424 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
3425 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3426 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3427 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3428 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3429 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3430 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3431 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3432 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3433 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
3434 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
3436 C Matrices dependent on two consecutive virtual-bond dihedrals.
3437 C The order of matrices is from left to right.
3439 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3440 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3441 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3442 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3443 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3444 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3445 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3446 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3449 cd iti = itortyp(itype(i))
3452 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3453 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3458 C--------------------------------------------------------------------------
3459 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3461 C This subroutine calculates the average interaction energy and its gradient
3462 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3463 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3464 C The potential depends both on the distance of peptide-group centers and on
3465 C the orientation of the CA-CA virtual bonds.
3467 implicit real*8 (a-h,o-z)
3468 include 'DIMENSIONS'
3469 include 'DIMENSIONS.ZSCOPT'
3470 include 'COMMON.CONTROL'
3471 include 'COMMON.IOUNITS'
3472 include 'COMMON.GEO'
3473 include 'COMMON.VAR'
3474 include 'COMMON.LOCAL'
3475 include 'COMMON.CHAIN'
3476 include 'COMMON.DERIV'
3477 include 'COMMON.INTERACT'
3478 include 'COMMON.CONTACTS'
3479 include 'COMMON.TORSION'
3480 include 'COMMON.VECTORS'
3481 include 'COMMON.FFIELD'
3482 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3483 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3484 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3485 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3486 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
3487 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3488 double precision scal_el /0.5d0/
3490 C 13-go grudnia roku pamietnego...
3491 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3492 & 0.0d0,1.0d0,0.0d0,
3493 & 0.0d0,0.0d0,1.0d0/
3494 cd write(iout,*) 'In EELEC'
3496 cd write(iout,*) 'Type',i
3497 cd write(iout,*) 'B1',B1(:,i)
3498 cd write(iout,*) 'B2',B2(:,i)
3499 cd write(iout,*) 'CC',CC(:,:,i)
3500 cd write(iout,*) 'DD',DD(:,:,i)
3501 cd write(iout,*) 'EE',EE(:,:,i)
3503 cd call check_vecgrad
3505 if (icheckgrad.eq.1) then
3507 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3509 dc_norm(k,i)=dc(k,i)*fac
3511 c write (iout,*) 'i',i,' fac',fac
3514 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3515 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3516 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3517 cd if (wel_loc.gt.0.0d0) then
3518 if (icheckgrad.eq.1) then
3519 call vec_and_deriv_test
3526 cd write (iout,*) 'i=',i
3528 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3531 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3532 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3545 cd print '(a)','Enter EELEC'
3546 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3548 gel_loc_loc(i)=0.0d0
3551 do i=iatel_s,iatel_e
3552 if (itel(i).eq.0) goto 1215
3556 dx_normi=dc_norm(1,i)
3557 dy_normi=dc_norm(2,i)
3558 dz_normi=dc_norm(3,i)
3559 xmedi=c(1,i)+0.5d0*dxi
3560 ymedi=c(2,i)+0.5d0*dyi
3561 zmedi=c(3,i)+0.5d0*dzi
3563 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3564 do j=ielstart(i),ielend(i)
3565 if (itel(j).eq.0) goto 1216
3569 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3570 aaa=app(iteli,itelj)
3571 bbb=bpp(iteli,itelj)
3572 C Diagnostics only!!!
3578 ael6i=ael6(iteli,itelj)
3579 ael3i=ael3(iteli,itelj)
3583 dx_normj=dc_norm(1,j)
3584 dy_normj=dc_norm(2,j)
3585 dz_normj=dc_norm(3,j)
3586 xj=c(1,j)+0.5D0*dxj-xmedi
3587 yj=c(2,j)+0.5D0*dyj-ymedi
3588 zj=c(3,j)+0.5D0*dzj-zmedi
3589 rij=xj*xj+yj*yj+zj*zj
3595 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3596 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3597 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3598 fac=cosa-3.0D0*cosb*cosg
3600 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3601 if (j.eq.i+2) ev1=scal_el*ev1
3606 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3609 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
3610 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3611 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3614 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3615 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3616 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3617 cd & xmedi,ymedi,zmedi,xj,yj,zj
3619 C Calculate contributions to the Cartesian gradient.
3622 facvdw=-6*rrmij*(ev1+evdwij)
3623 facel=-3*rrmij*(el1+eesij)
3630 * Radial derivatives. First process both termini of the fragment (i,j)
3637 gelc(k,i)=gelc(k,i)+ghalf
3638 gelc(k,j)=gelc(k,j)+ghalf
3641 * Loop over residues i+1 thru j-1.
3645 gelc(l,k)=gelc(l,k)+ggg(l)
3653 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3654 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3657 * Loop over residues i+1 thru j-1.
3661 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3668 fac=-3*rrmij*(facvdw+facvdw+facel)
3674 * Radial derivatives. First process both termini of the fragment (i,j)
3681 gelc(k,i)=gelc(k,i)+ghalf
3682 gelc(k,j)=gelc(k,j)+ghalf
3685 * Loop over residues i+1 thru j-1.
3689 gelc(l,k)=gelc(l,k)+ggg(l)
3696 ecosa=2.0D0*fac3*fac1+fac4
3699 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3700 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3702 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3703 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3705 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3706 cd & (dcosg(k),k=1,3)
3708 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3712 gelc(k,i)=gelc(k,i)+ghalf
3713 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3714 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3715 gelc(k,j)=gelc(k,j)+ghalf
3716 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3717 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3721 gelc(l,k)=gelc(l,k)+ggg(l)
3726 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3727 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3728 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3730 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3731 C energy of a peptide unit is assumed in the form of a second-order
3732 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3733 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3734 C are computed for EVERY pair of non-contiguous peptide groups.
3736 if (j.lt.nres-1) then
3747 muij(kkk)=mu(k,i)*mu(l,j)
3750 cd write (iout,*) 'EELEC: i',i,' j',j
3751 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3752 cd write(iout,*) 'muij',muij
3753 ury=scalar(uy(1,i),erij)
3754 urz=scalar(uz(1,i),erij)
3755 vry=scalar(uy(1,j),erij)
3756 vrz=scalar(uz(1,j),erij)
3757 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3758 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3759 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3760 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3761 C For diagnostics only
3766 fac=dsqrt(-ael6i)*r3ij
3767 cd write (2,*) 'fac=',fac
3768 C For diagnostics only
3774 cd write (iout,'(4i5,4f10.5)')
3775 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3776 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3777 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
3778 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
3779 cd write (iout,'(4f10.5)')
3780 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3781 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3782 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3783 cd write (iout,'(2i3,9f10.5/)') i,j,
3784 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3786 C Derivatives of the elements of A in virtual-bond vectors
3787 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3794 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3795 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3796 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3797 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3798 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3799 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3800 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3801 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3802 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3803 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3804 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3805 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3815 C Compute radial contributions to the gradient
3837 C Add the contributions coming from er
3840 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3841 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3842 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3843 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3846 C Derivatives in DC(i)
3847 ghalf1=0.5d0*agg(k,1)
3848 ghalf2=0.5d0*agg(k,2)
3849 ghalf3=0.5d0*agg(k,3)
3850 ghalf4=0.5d0*agg(k,4)
3851 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3852 & -3.0d0*uryg(k,2)*vry)+ghalf1
3853 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3854 & -3.0d0*uryg(k,2)*vrz)+ghalf2
3855 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3856 & -3.0d0*urzg(k,2)*vry)+ghalf3
3857 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3858 & -3.0d0*urzg(k,2)*vrz)+ghalf4
3859 C Derivatives in DC(i+1)
3860 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3861 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
3862 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3863 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
3864 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3865 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
3866 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3867 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
3868 C Derivatives in DC(j)
3869 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3870 & -3.0d0*vryg(k,2)*ury)+ghalf1
3871 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3872 & -3.0d0*vrzg(k,2)*ury)+ghalf2
3873 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3874 & -3.0d0*vryg(k,2)*urz)+ghalf3
3875 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3876 & -3.0d0*vrzg(k,2)*urz)+ghalf4
3877 C Derivatives in DC(j+1) or DC(nres-1)
3878 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3879 & -3.0d0*vryg(k,3)*ury)
3880 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3881 & -3.0d0*vrzg(k,3)*ury)
3882 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3883 & -3.0d0*vryg(k,3)*urz)
3884 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3885 & -3.0d0*vrzg(k,3)*urz)
3890 C Derivatives in DC(i+1)
3891 cd aggi1(k,1)=agg(k,1)
3892 cd aggi1(k,2)=agg(k,2)
3893 cd aggi1(k,3)=agg(k,3)
3894 cd aggi1(k,4)=agg(k,4)
3895 C Derivatives in DC(j)
3900 C Derivatives in DC(j+1)
3905 if (j.eq.nres-1 .and. i.lt.j-2) then
3907 aggj1(k,l)=aggj1(k,l)+agg(k,l)
3908 cd aggj1(k,l)=agg(k,l)
3914 C Check the loc-el terms by numerical integration
3924 aggi(k,l)=-aggi(k,l)
3925 aggi1(k,l)=-aggi1(k,l)
3926 aggj(k,l)=-aggj(k,l)
3927 aggj1(k,l)=-aggj1(k,l)
3930 if (j.lt.nres-1) then
3936 aggi(k,l)=-aggi(k,l)
3937 aggi1(k,l)=-aggi1(k,l)
3938 aggj(k,l)=-aggj(k,l)
3939 aggj1(k,l)=-aggj1(k,l)
3950 aggi(k,l)=-aggi(k,l)
3951 aggi1(k,l)=-aggi1(k,l)
3952 aggj(k,l)=-aggj(k,l)
3953 aggj1(k,l)=-aggj1(k,l)
3959 IF (wel_loc.gt.0.0d0) THEN
3960 C Contribution to the local-electrostatic energy coming from the i-j pair
3961 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3963 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3964 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3965 eel_loc=eel_loc+eel_loc_ij
3966 C Partial derivatives in virtual-bond dihedral angles gamma
3969 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3970 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3971 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3972 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3973 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3974 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3975 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
3976 cd write(iout,*) 'agg ',agg
3977 cd write(iout,*) 'aggi ',aggi
3978 cd write(iout,*) 'aggi1',aggi1
3979 cd write(iout,*) 'aggj ',aggj
3980 cd write(iout,*) 'aggj1',aggj1
3982 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3984 ggg(l)=agg(l,1)*muij(1)+
3985 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3989 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3992 C Remaining derivatives of eello
3994 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3995 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3996 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3997 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3998 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3999 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
4000 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
4001 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
4005 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4006 C Contributions from turns
4011 call eturn34(i,j,eello_turn3,eello_turn4)
4013 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4014 if (j.gt.i+1 .and. num_conti.le.maxconts) then
4016 C Calculate the contact function. The ith column of the array JCONT will
4017 C contain the numbers of atoms that make contacts with the atom I (of numbers
4018 C greater than I). The arrays FACONT and GACONT will contain the values of
4019 C the contact function and its derivative.
4020 c r0ij=1.02D0*rpp(iteli,itelj)
4021 c r0ij=1.11D0*rpp(iteli,itelj)
4022 r0ij=2.20D0*rpp(iteli,itelj)
4023 c r0ij=1.55D0*rpp(iteli,itelj)
4024 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4025 if (fcont.gt.0.0D0) then
4026 num_conti=num_conti+1
4027 if (num_conti.gt.maxconts) then
4028 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4029 & ' will skip next contacts for this conf.'
4031 jcont_hb(num_conti,i)=j
4032 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4033 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4034 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4036 d_cont(num_conti,i)=rij
4037 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4038 C --- Electrostatic-interaction matrix ---
4039 a_chuj(1,1,num_conti,i)=a22
4040 a_chuj(1,2,num_conti,i)=a23
4041 a_chuj(2,1,num_conti,i)=a32
4042 a_chuj(2,2,num_conti,i)=a33
4043 C --- Gradient of rij
4045 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4048 c a_chuj(1,1,num_conti,i)=-0.61d0
4049 c a_chuj(1,2,num_conti,i)= 0.4d0
4050 c a_chuj(2,1,num_conti,i)= 0.65d0
4051 c a_chuj(2,2,num_conti,i)= 0.50d0
4052 c else if (i.eq.2) then
4053 c a_chuj(1,1,num_conti,i)= 0.0d0
4054 c a_chuj(1,2,num_conti,i)= 0.0d0
4055 c a_chuj(2,1,num_conti,i)= 0.0d0
4056 c a_chuj(2,2,num_conti,i)= 0.0d0
4058 C --- and its gradients
4059 cd write (iout,*) 'i',i,' j',j
4061 cd write (iout,*) 'iii 1 kkk',kkk
4062 cd write (iout,*) agg(kkk,:)
4065 cd write (iout,*) 'iii 2 kkk',kkk
4066 cd write (iout,*) aggi(kkk,:)
4069 cd write (iout,*) 'iii 3 kkk',kkk
4070 cd write (iout,*) aggi1(kkk,:)
4073 cd write (iout,*) 'iii 4 kkk',kkk
4074 cd write (iout,*) aggj(kkk,:)
4077 cd write (iout,*) 'iii 5 kkk',kkk
4078 cd write (iout,*) aggj1(kkk,:)
4085 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4086 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4087 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4088 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4089 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4091 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
4097 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4098 C Calculate contact energies
4100 wij=cosa-3.0D0*cosb*cosg
4103 c fac3=dsqrt(-ael6i)/r0ij**3
4104 fac3=dsqrt(-ael6i)*r3ij
4105 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4106 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4108 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4109 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4110 C Diagnostics. Comment out or remove after debugging!
4111 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4112 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4113 c ees0m(num_conti,i)=0.0D0
4115 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4116 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4117 facont_hb(num_conti,i)=fcont
4119 C Angular derivatives of the contact function
4120 ees0pij1=fac3/ees0pij
4121 ees0mij1=fac3/ees0mij
4122 fac3p=-3.0D0*fac3*rrmij
4123 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4124 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4126 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4127 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4128 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4129 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4130 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4131 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4132 ecosap=ecosa1+ecosa2
4133 ecosbp=ecosb1+ecosb2
4134 ecosgp=ecosg1+ecosg2
4135 ecosam=ecosa1-ecosa2
4136 ecosbm=ecosb1-ecosb2
4137 ecosgm=ecosg1-ecosg2
4146 fprimcont=fprimcont/rij
4147 cd facont_hb(num_conti,i)=1.0D0
4148 C Following line is for diagnostics.
4151 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4152 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4155 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4156 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4158 gggp(1)=gggp(1)+ees0pijp*xj
4159 gggp(2)=gggp(2)+ees0pijp*yj
4160 gggp(3)=gggp(3)+ees0pijp*zj
4161 gggm(1)=gggm(1)+ees0mijp*xj
4162 gggm(2)=gggm(2)+ees0mijp*yj
4163 gggm(3)=gggm(3)+ees0mijp*zj
4164 C Derivatives due to the contact function
4165 gacont_hbr(1,num_conti,i)=fprimcont*xj
4166 gacont_hbr(2,num_conti,i)=fprimcont*yj
4167 gacont_hbr(3,num_conti,i)=fprimcont*zj
4169 ghalfp=0.5D0*gggp(k)
4170 ghalfm=0.5D0*gggm(k)
4171 gacontp_hb1(k,num_conti,i)=ghalfp
4172 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4173 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4174 gacontp_hb2(k,num_conti,i)=ghalfp
4175 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4176 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4177 gacontp_hb3(k,num_conti,i)=gggp(k)
4178 gacontm_hb1(k,num_conti,i)=ghalfm
4179 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4180 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4181 gacontm_hb2(k,num_conti,i)=ghalfm
4182 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4183 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4184 gacontm_hb3(k,num_conti,i)=gggm(k)
4187 C Diagnostics. Comment out or remove after debugging!
4189 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4190 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4191 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4192 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4193 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4194 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4197 endif ! num_conti.le.maxconts
4202 num_cont_hb(i)=num_conti
4206 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
4207 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
4209 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
4210 ccc eel_loc=eel_loc+eello_turn3
4213 C-----------------------------------------------------------------------------
4214 subroutine eturn34(i,j,eello_turn3,eello_turn4)
4215 C Third- and fourth-order contributions from turns
4216 implicit real*8 (a-h,o-z)
4217 include 'DIMENSIONS'
4218 include 'DIMENSIONS.ZSCOPT'
4219 include 'COMMON.IOUNITS'
4220 include 'COMMON.GEO'
4221 include 'COMMON.VAR'
4222 include 'COMMON.LOCAL'
4223 include 'COMMON.CHAIN'
4224 include 'COMMON.DERIV'
4225 include 'COMMON.INTERACT'
4226 include 'COMMON.CONTACTS'
4227 include 'COMMON.TORSION'
4228 include 'COMMON.VECTORS'
4229 include 'COMMON.FFIELD'
4231 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4232 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4233 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
4234 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4235 & aggj(3,4),aggj1(3,4),a_temp(2,2)
4236 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
4238 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4240 C Third-order contributions
4247 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4248 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4249 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4250 call transpose2(auxmat(1,1),auxmat1(1,1))
4251 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4252 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4253 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4254 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4255 cd & ' eello_turn3_num',4*eello_turn3_num
4257 C Derivatives in gamma(i)
4258 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4259 call transpose2(auxmat2(1,1),pizda(1,1))
4260 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4261 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4262 C Derivatives in gamma(i+1)
4263 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4264 call transpose2(auxmat2(1,1),pizda(1,1))
4265 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4266 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4267 & +0.5d0*(pizda(1,1)+pizda(2,2))
4268 C Cartesian derivatives
4270 a_temp(1,1)=aggi(l,1)
4271 a_temp(1,2)=aggi(l,2)
4272 a_temp(2,1)=aggi(l,3)
4273 a_temp(2,2)=aggi(l,4)
4274 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4275 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4276 & +0.5d0*(pizda(1,1)+pizda(2,2))
4277 a_temp(1,1)=aggi1(l,1)
4278 a_temp(1,2)=aggi1(l,2)
4279 a_temp(2,1)=aggi1(l,3)
4280 a_temp(2,2)=aggi1(l,4)
4281 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4282 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4283 & +0.5d0*(pizda(1,1)+pizda(2,2))
4284 a_temp(1,1)=aggj(l,1)
4285 a_temp(1,2)=aggj(l,2)
4286 a_temp(2,1)=aggj(l,3)
4287 a_temp(2,2)=aggj(l,4)
4288 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4289 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4290 & +0.5d0*(pizda(1,1)+pizda(2,2))
4291 a_temp(1,1)=aggj1(l,1)
4292 a_temp(1,2)=aggj1(l,2)
4293 a_temp(2,1)=aggj1(l,3)
4294 a_temp(2,2)=aggj1(l,4)
4295 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4296 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4297 & +0.5d0*(pizda(1,1)+pizda(2,2))
4300 else if (j.eq.i+3) then
4301 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4303 C Fourth-order contributions
4311 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4312 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4313 iti1=itortyp(itype(i+1))
4314 iti2=itortyp(itype(i+2))
4315 iti3=itortyp(itype(i+3))
4316 call transpose2(EUg(1,1,i+1),e1t(1,1))
4317 call transpose2(Eug(1,1,i+2),e2t(1,1))
4318 call transpose2(Eug(1,1,i+3),e3t(1,1))
4319 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4320 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4321 s1=scalar2(b1(1,iti2),auxvec(1))
4322 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4323 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4324 s2=scalar2(b1(1,iti1),auxvec(1))
4325 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4326 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4327 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4328 eello_turn4=eello_turn4-(s1+s2+s3)
4329 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4330 cd & ' eello_turn4_num',8*eello_turn4_num
4331 C Derivatives in gamma(i)
4333 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4334 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4335 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4336 s1=scalar2(b1(1,iti2),auxvec(1))
4337 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4338 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4339 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4340 C Derivatives in gamma(i+1)
4341 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4342 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4343 s2=scalar2(b1(1,iti1),auxvec(1))
4344 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4345 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4346 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4347 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4348 C Derivatives in gamma(i+2)
4349 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4350 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4351 s1=scalar2(b1(1,iti2),auxvec(1))
4352 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4353 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4354 s2=scalar2(b1(1,iti1),auxvec(1))
4355 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
4356 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4357 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4358 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4359 C Cartesian derivatives
4360 C Derivatives of this turn contributions in DC(i+2)
4361 if (j.lt.nres-1) then
4363 a_temp(1,1)=agg(l,1)
4364 a_temp(1,2)=agg(l,2)
4365 a_temp(2,1)=agg(l,3)
4366 a_temp(2,2)=agg(l,4)
4367 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4368 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4369 s1=scalar2(b1(1,iti2),auxvec(1))
4370 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4371 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4372 s2=scalar2(b1(1,iti1),auxvec(1))
4373 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4374 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4375 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4377 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4380 C Remaining derivatives of this turn contribution
4382 a_temp(1,1)=aggi(l,1)
4383 a_temp(1,2)=aggi(l,2)
4384 a_temp(2,1)=aggi(l,3)
4385 a_temp(2,2)=aggi(l,4)
4386 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4387 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4388 s1=scalar2(b1(1,iti2),auxvec(1))
4389 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4390 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4391 s2=scalar2(b1(1,iti1),auxvec(1))
4392 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4393 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4394 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4395 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4396 a_temp(1,1)=aggi1(l,1)
4397 a_temp(1,2)=aggi1(l,2)
4398 a_temp(2,1)=aggi1(l,3)
4399 a_temp(2,2)=aggi1(l,4)
4400 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4401 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4402 s1=scalar2(b1(1,iti2),auxvec(1))
4403 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4404 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4405 s2=scalar2(b1(1,iti1),auxvec(1))
4406 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4407 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4408 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4409 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4410 a_temp(1,1)=aggj(l,1)
4411 a_temp(1,2)=aggj(l,2)
4412 a_temp(2,1)=aggj(l,3)
4413 a_temp(2,2)=aggj(l,4)
4414 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4415 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4416 s1=scalar2(b1(1,iti2),auxvec(1))
4417 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4418 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4419 s2=scalar2(b1(1,iti1),auxvec(1))
4420 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4421 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4422 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4423 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4424 a_temp(1,1)=aggj1(l,1)
4425 a_temp(1,2)=aggj1(l,2)
4426 a_temp(2,1)=aggj1(l,3)
4427 a_temp(2,2)=aggj1(l,4)
4428 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4429 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4430 s1=scalar2(b1(1,iti2),auxvec(1))
4431 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4432 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4433 s2=scalar2(b1(1,iti1),auxvec(1))
4434 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4435 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4436 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4437 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4443 C-----------------------------------------------------------------------------
4444 subroutine vecpr(u,v,w)
4445 implicit real*8(a-h,o-z)
4446 dimension u(3),v(3),w(3)
4447 w(1)=u(2)*v(3)-u(3)*v(2)
4448 w(2)=-u(1)*v(3)+u(3)*v(1)
4449 w(3)=u(1)*v(2)-u(2)*v(1)
4452 C-----------------------------------------------------------------------------
4453 subroutine unormderiv(u,ugrad,unorm,ungrad)
4454 C This subroutine computes the derivatives of a normalized vector u, given
4455 C the derivatives computed without normalization conditions, ugrad. Returns
4458 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4459 double precision vec(3)
4460 double precision scalar
4462 c write (2,*) 'ugrad',ugrad
4465 vec(i)=scalar(ugrad(1,i),u(1))
4467 c write (2,*) 'vec',vec
4470 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4473 c write (2,*) 'ungrad',ungrad
4476 C-----------------------------------------------------------------------------
4477 subroutine escp(evdw2,evdw2_14)
4479 C This subroutine calculates the excluded-volume interaction energy between
4480 C peptide-group centers and side chains and its gradient in virtual-bond and
4481 C side-chain vectors.
4483 implicit real*8 (a-h,o-z)
4484 include 'DIMENSIONS'
4485 include 'DIMENSIONS.ZSCOPT'
4486 include 'COMMON.GEO'
4487 include 'COMMON.VAR'
4488 include 'COMMON.LOCAL'
4489 include 'COMMON.CHAIN'
4490 include 'COMMON.DERIV'
4491 include 'COMMON.INTERACT'
4492 include 'COMMON.FFIELD'
4493 include 'COMMON.IOUNITS'
4497 cd print '(a)','Enter ESCP'
4498 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4499 c & ' scal14',scal14
4500 do i=iatscp_s,iatscp_e
4502 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4503 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4504 if (iteli.eq.0) goto 1225
4505 xi=0.5D0*(c(1,i)+c(1,i+1))
4506 yi=0.5D0*(c(2,i)+c(2,i+1))
4507 zi=0.5D0*(c(3,i)+c(3,i+1))
4509 do iint=1,nscp_gr(i)
4511 do j=iscpstart(i,iint),iscpend(i,iint)
4513 C Uncomment following three lines for SC-p interactions
4517 C Uncomment following three lines for Ca-p interactions
4521 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4523 e1=fac*fac*aad(itypj,iteli)
4524 e2=fac*bad(itypj,iteli)
4525 if (iabs(j-i) .le. 2) then
4528 evdw2_14=evdw2_14+e1+e2
4531 c write (iout,*) i,j,evdwij
4535 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4537 fac=-(evdwij+e1)*rrij
4542 cd write (iout,*) 'j<i'
4543 C Uncomment following three lines for SC-p interactions
4545 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4548 cd write (iout,*) 'j>i'
4551 C Uncomment following line for SC-p interactions
4552 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4556 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4560 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4561 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4564 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4574 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4575 gradx_scp(j,i)=expon*gradx_scp(j,i)
4578 C******************************************************************************
4582 C To save time the factor EXPON has been extracted from ALL components
4583 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4586 C******************************************************************************
4589 C--------------------------------------------------------------------------
4590 subroutine edis(ehpb)
4592 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4594 implicit real*8 (a-h,o-z)
4595 include 'DIMENSIONS'
4596 include 'COMMON.SBRIDGE'
4597 include 'COMMON.CHAIN'
4598 include 'COMMON.DERIV'
4599 include 'COMMON.VAR'
4600 include 'COMMON.INTERACT'
4601 include 'COMMON.IOUNITS'
4604 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4605 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4606 if (link_end.eq.0) return
4607 do i=link_start,link_end
4608 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4609 C CA-CA distance used in regularization of structure.
4612 C iii and jjj point to the residues for which the distance is assigned.
4613 if (ii.gt.nres) then
4620 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4621 c & dhpb(i),dhpb1(i),forcon(i)
4622 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4623 C distance and angle dependent SS bond potential.
4624 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4625 call ssbond_ene(iii,jjj,eij)
4627 cd write (iout,*) "eij",eij
4628 else if (ii.gt.nres .and. jj.gt.nres) then
4629 c Restraints from contact prediction
4631 if (dhpb1(i).gt.0.0d0) then
4632 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4633 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4634 c write (iout,*) "beta nmr",
4635 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4639 C Get the force constant corresponding to this distance.
4641 C Calculate the contribution to energy.
4642 ehpb=ehpb+waga*rdis*rdis
4643 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4645 C Evaluate gradient.
4650 ggg(j)=fac*(c(j,jj)-c(j,ii))
4653 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4654 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4657 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4658 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4661 C Calculate the distance between the two points and its difference from the
4664 if (dhpb1(i).gt.0.0d0) then
4665 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4666 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4667 c write (iout,*) "alph nmr",
4668 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4671 C Get the force constant corresponding to this distance.
4673 C Calculate the contribution to energy.
4674 ehpb=ehpb+waga*rdis*rdis
4675 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4677 C Evaluate gradient.
4681 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4682 cd & ' waga=',waga,' fac=',fac
4684 ggg(j)=fac*(c(j,jj)-c(j,ii))
4686 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4687 C If this is a SC-SC distance, we need to calculate the contributions to the
4688 C Cartesian gradient in the SC vectors (ghpbx).
4691 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4692 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4696 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4697 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4704 C--------------------------------------------------------------------------
4705 subroutine ssbond_ene(i,j,eij)
4707 C Calculate the distance and angle dependent SS-bond potential energy
4708 C using a free-energy function derived based on RHF/6-31G** ab initio
4709 C calculations of diethyl disulfide.
4711 C A. Liwo and U. Kozlowska, 11/24/03
4713 implicit real*8 (a-h,o-z)
4714 include 'DIMENSIONS'
4715 include 'DIMENSIONS.ZSCOPT'
4716 include 'COMMON.SBRIDGE'
4717 include 'COMMON.CHAIN'
4718 include 'COMMON.DERIV'
4719 include 'COMMON.LOCAL'
4720 include 'COMMON.INTERACT'
4721 include 'COMMON.VAR'
4722 include 'COMMON.IOUNITS'
4723 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4728 dxi=dc_norm(1,nres+i)
4729 dyi=dc_norm(2,nres+i)
4730 dzi=dc_norm(3,nres+i)
4731 dsci_inv=dsc_inv(itypi)
4733 dscj_inv=dsc_inv(itypj)
4737 dxj=dc_norm(1,nres+j)
4738 dyj=dc_norm(2,nres+j)
4739 dzj=dc_norm(3,nres+j)
4740 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4745 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4746 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4747 om12=dxi*dxj+dyi*dyj+dzi*dzj
4749 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4750 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4756 deltat12=om2-om1+2.0d0
4758 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4759 & +akct*deltad*deltat12
4760 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4761 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4762 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4763 c & " deltat12",deltat12," eij",eij
4764 ed=2*akcm*deltad+akct*deltat12
4766 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4767 eom1=-2*akth*deltat1-pom1-om2*pom2
4768 eom2= 2*akth*deltat2+pom1-om1*pom2
4771 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4774 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4775 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4776 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4777 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4780 C Calculate the components of the gradient in DC and X
4784 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4789 C--------------------------------------------------------------------------
4790 subroutine ebond(estr)
4792 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4794 implicit real*8 (a-h,o-z)
4795 include 'DIMENSIONS'
4796 include 'DIMENSIONS.ZSCOPT'
4797 include 'COMMON.LOCAL'
4798 include 'COMMON.GEO'
4799 include 'COMMON.INTERACT'
4800 include 'COMMON.DERIV'
4801 include 'COMMON.VAR'
4802 include 'COMMON.CHAIN'
4803 include 'COMMON.IOUNITS'
4804 include 'COMMON.NAMES'
4805 include 'COMMON.FFIELD'
4806 include 'COMMON.CONTROL'
4807 double precision u(3),ud(3)
4810 diff = vbld(i)-vbldp0
4811 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4814 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4819 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4826 diff=vbld(i+nres)-vbldsc0(1,iti)
4827 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4828 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4829 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4831 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4835 diff=vbld(i+nres)-vbldsc0(j,iti)
4836 ud(j)=aksc(j,iti)*diff
4837 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4851 uprod2=uprod2*u(k)*u(k)
4855 usumsqder=usumsqder+ud(j)*uprod2
4857 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4858 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4859 estr=estr+uprod/usum
4861 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4869 C--------------------------------------------------------------------------
4870 subroutine ebend(etheta)
4872 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4873 C angles gamma and its derivatives in consecutive thetas and gammas.
4875 implicit real*8 (a-h,o-z)
4876 include 'DIMENSIONS'
4877 include 'DIMENSIONS.ZSCOPT'
4878 include 'COMMON.LOCAL'
4879 include 'COMMON.GEO'
4880 include 'COMMON.INTERACT'
4881 include 'COMMON.DERIV'
4882 include 'COMMON.VAR'
4883 include 'COMMON.CHAIN'
4884 include 'COMMON.IOUNITS'
4885 include 'COMMON.NAMES'
4886 include 'COMMON.FFIELD'
4887 common /calcthet/ term1,term2,termm,diffak,ratak,
4888 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4889 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4890 double precision y(2),z(2)
4892 time11=dexp(-2*time)
4895 c write (iout,*) "nres",nres
4896 c write (*,'(a,i2)') 'EBEND ICG=',icg
4897 c write (iout,*) ithet_start,ithet_end
4898 do i=ithet_start,ithet_end
4899 C Zero the energy function and its derivative at 0 or pi.
4900 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4902 c if (i.gt.ithet_start .and.
4903 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
4904 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
4912 c if (i.lt.nres .and. itel(i).ne.0) then
4924 call proc_proc(phii,icrc)
4925 if (icrc.eq.1) phii=150.0
4939 call proc_proc(phii1,icrc)
4940 if (icrc.eq.1) phii1=150.0
4952 C Calculate the "mean" value of theta from the part of the distribution
4953 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4954 C In following comments this theta will be referred to as t_c.
4955 thet_pred_mean=0.0d0
4959 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4961 c write (iout,*) "thet_pred_mean",thet_pred_mean
4962 dthett=thet_pred_mean*ssd
4963 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4964 c write (iout,*) "thet_pred_mean",thet_pred_mean
4965 C Derivatives of the "mean" values in gamma1 and gamma2.
4966 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4967 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4968 if (theta(i).gt.pi-delta) then
4969 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4971 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4972 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4973 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4975 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4977 else if (theta(i).lt.delta) then
4978 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4979 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4980 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4982 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4983 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4986 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4989 etheta=etheta+ethetai
4990 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4991 c & rad2deg*phii,rad2deg*phii1,ethetai
4992 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4993 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4994 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4997 C Ufff.... We've done all this!!!
5000 C---------------------------------------------------------------------------
5001 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5003 implicit real*8 (a-h,o-z)
5004 include 'DIMENSIONS'
5005 include 'COMMON.LOCAL'
5006 include 'COMMON.IOUNITS'
5007 common /calcthet/ term1,term2,termm,diffak,ratak,
5008 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5009 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5010 C Calculate the contributions to both Gaussian lobes.
5011 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5012 C The "polynomial part" of the "standard deviation" of this part of
5016 sig=sig*thet_pred_mean+polthet(j,it)
5018 C Derivative of the "interior part" of the "standard deviation of the"
5019 C gamma-dependent Gaussian lobe in t_c.
5020 sigtc=3*polthet(3,it)
5022 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5025 C Set the parameters of both Gaussian lobes of the distribution.
5026 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5027 fac=sig*sig+sigc0(it)
5030 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5031 sigsqtc=-4.0D0*sigcsq*sigtc
5032 c print *,i,sig,sigtc,sigsqtc
5033 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5034 sigtc=-sigtc/(fac*fac)
5035 C Following variable is sigma(t_c)**(-2)
5036 sigcsq=sigcsq*sigcsq
5038 sig0inv=1.0D0/sig0i**2
5039 delthec=thetai-thet_pred_mean
5040 delthe0=thetai-theta0i
5041 term1=-0.5D0*sigcsq*delthec*delthec
5042 term2=-0.5D0*sig0inv*delthe0*delthe0
5043 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5044 C NaNs in taking the logarithm. We extract the largest exponent which is added
5045 C to the energy (this being the log of the distribution) at the end of energy
5046 C term evaluation for this virtual-bond angle.
5047 if (term1.gt.term2) then
5049 term2=dexp(term2-termm)
5053 term1=dexp(term1-termm)
5056 C The ratio between the gamma-independent and gamma-dependent lobes of
5057 C the distribution is a Gaussian function of thet_pred_mean too.
5058 diffak=gthet(2,it)-thet_pred_mean
5059 ratak=diffak/gthet(3,it)**2
5060 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5061 C Let's differentiate it in thet_pred_mean NOW.
5063 C Now put together the distribution terms to make complete distribution.
5064 termexp=term1+ak*term2
5065 termpre=sigc+ak*sig0i
5066 C Contribution of the bending energy from this theta is just the -log of
5067 C the sum of the contributions from the two lobes and the pre-exponential
5068 C factor. Simple enough, isn't it?
5069 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5070 C NOW the derivatives!!!
5071 C 6/6/97 Take into account the deformation.
5072 E_theta=(delthec*sigcsq*term1
5073 & +ak*delthe0*sig0inv*term2)/termexp
5074 E_tc=((sigtc+aktc*sig0i)/termpre
5075 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5076 & aktc*term2)/termexp)
5079 c-----------------------------------------------------------------------------
5080 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5081 implicit real*8 (a-h,o-z)
5082 include 'DIMENSIONS'
5083 include 'COMMON.LOCAL'
5084 include 'COMMON.IOUNITS'
5085 common /calcthet/ term1,term2,termm,diffak,ratak,
5086 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5087 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5088 delthec=thetai-thet_pred_mean
5089 delthe0=thetai-theta0i
5090 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5091 t3 = thetai-thet_pred_mean
5095 t14 = t12+t6*sigsqtc
5097 t21 = thetai-theta0i
5103 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5104 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5105 & *(-t12*t9-ak*sig0inv*t27)
5109 C--------------------------------------------------------------------------
5110 subroutine ebend(etheta)
5112 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5113 C angles gamma and its derivatives in consecutive thetas and gammas.
5114 C ab initio-derived potentials from
5115 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5117 implicit real*8 (a-h,o-z)
5118 include 'DIMENSIONS'
5119 include 'DIMENSIONS.ZSCOPT'
5120 include 'COMMON.LOCAL'
5121 include 'COMMON.GEO'
5122 include 'COMMON.INTERACT'
5123 include 'COMMON.DERIV'
5124 include 'COMMON.VAR'
5125 include 'COMMON.CHAIN'
5126 include 'COMMON.IOUNITS'
5127 include 'COMMON.NAMES'
5128 include 'COMMON.FFIELD'
5129 include 'COMMON.CONTROL'
5130 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5131 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5132 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5133 & sinph1ph2(maxdouble,maxdouble)
5134 logical lprn /.false./, lprn1 /.false./
5136 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5137 do i=ithet_start,ithet_end
5141 theti2=0.5d0*theta(i)
5142 ityp2=ithetyp(itype(i-1))
5144 coskt(k)=dcos(k*theti2)
5145 sinkt(k)=dsin(k*theti2)
5150 if (phii.ne.phii) phii=150.0
5154 ityp1=ithetyp(itype(i-2))
5156 cosph1(k)=dcos(k*phii)
5157 sinph1(k)=dsin(k*phii)
5170 if (phii1.ne.phii1) phii1=150.0
5175 ityp3=ithetyp(itype(i))
5177 cosph2(k)=dcos(k*phii1)
5178 sinph2(k)=dsin(k*phii1)
5188 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5189 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5191 ethetai=aa0thet(ityp1,ityp2,ityp3)
5194 ccl=cosph1(l)*cosph2(k-l)
5195 ssl=sinph1(l)*sinph2(k-l)
5196 scl=sinph1(l)*cosph2(k-l)
5197 csl=cosph1(l)*sinph2(k-l)
5198 cosph1ph2(l,k)=ccl-ssl
5199 cosph1ph2(k,l)=ccl+ssl
5200 sinph1ph2(l,k)=scl+csl
5201 sinph1ph2(k,l)=scl-csl
5205 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5206 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5207 write (iout,*) "coskt and sinkt"
5209 write (iout,*) k,coskt(k),sinkt(k)
5213 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
5214 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
5217 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
5218 & " ethetai",ethetai
5221 write (iout,*) "cosph and sinph"
5223 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5225 write (iout,*) "cosph1ph2 and sinph2ph2"
5228 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5229 & sinph1ph2(l,k),sinph1ph2(k,l)
5232 write(iout,*) "ethetai",ethetai
5236 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
5237 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
5238 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
5239 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
5240 ethetai=ethetai+sinkt(m)*aux
5241 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5242 dephii=dephii+k*sinkt(m)*(
5243 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
5244 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
5245 dephii1=dephii1+k*sinkt(m)*(
5246 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
5247 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
5249 & write (iout,*) "m",m," k",k," bbthet",
5250 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
5251 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
5252 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
5253 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5257 & write(iout,*) "ethetai",ethetai
5261 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5262 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
5263 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5264 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
5265 ethetai=ethetai+sinkt(m)*aux
5266 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5267 dephii=dephii+l*sinkt(m)*(
5268 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
5269 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5270 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5271 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5272 dephii1=dephii1+(k-l)*sinkt(m)*(
5273 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5274 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5275 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5276 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5278 write (iout,*) "m",m," k",k," l",l," ffthet",
5279 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5280 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5281 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5282 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5283 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5284 & cosph1ph2(k,l)*sinkt(m),
5285 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5291 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5292 & i,theta(i)*rad2deg,phii*rad2deg,
5293 & phii1*rad2deg,ethetai
5294 etheta=etheta+ethetai
5295 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5296 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5297 gloc(nphi+i-2,icg)=wang*dethetai
5303 c-----------------------------------------------------------------------------
5304 subroutine esc(escloc)
5305 C Calculate the local energy of a side chain and its derivatives in the
5306 C corresponding virtual-bond valence angles THETA and the spherical angles
5308 implicit real*8 (a-h,o-z)
5309 include 'DIMENSIONS'
5310 include 'DIMENSIONS.ZSCOPT'
5311 include 'COMMON.GEO'
5312 include 'COMMON.LOCAL'
5313 include 'COMMON.VAR'
5314 include 'COMMON.INTERACT'
5315 include 'COMMON.DERIV'
5316 include 'COMMON.CHAIN'
5317 include 'COMMON.IOUNITS'
5318 include 'COMMON.NAMES'
5319 include 'COMMON.FFIELD'
5320 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5321 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5322 common /sccalc/ time11,time12,time112,theti,it,nlobit
5325 c write (iout,'(a)') 'ESC'
5326 do i=loc_start,loc_end
5328 if (it.eq.10) goto 1
5330 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5331 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5332 theti=theta(i+1)-pipol
5336 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5338 if (x(2).gt.pi-delta) then
5342 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5344 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5345 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5347 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5348 & ddersc0(1),dersc(1))
5349 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5350 & ddersc0(3),dersc(3))
5352 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5354 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5355 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5356 & dersc0(2),esclocbi,dersc02)
5357 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5359 call splinthet(x(2),0.5d0*delta,ss,ssd)
5364 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5366 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5367 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5369 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5371 c write (iout,*) escloci
5372 else if (x(2).lt.delta) then
5376 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5378 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5379 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5381 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5382 & ddersc0(1),dersc(1))
5383 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5384 & ddersc0(3),dersc(3))
5386 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5388 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5389 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5390 & dersc0(2),esclocbi,dersc02)
5391 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5396 call splinthet(x(2),0.5d0*delta,ss,ssd)
5398 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5400 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5401 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5403 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5404 c write (iout,*) escloci
5406 call enesc(x,escloci,dersc,ddummy,.false.)
5409 escloc=escloc+escloci
5410 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5412 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5414 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5415 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5420 C---------------------------------------------------------------------------
5421 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5422 implicit real*8 (a-h,o-z)
5423 include 'DIMENSIONS'
5424 include 'COMMON.GEO'
5425 include 'COMMON.LOCAL'
5426 include 'COMMON.IOUNITS'
5427 common /sccalc/ time11,time12,time112,theti,it,nlobit
5428 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5429 double precision contr(maxlob,-1:1)
5431 c write (iout,*) 'it=',it,' nlobit=',nlobit
5435 if (mixed) ddersc(j)=0.0d0
5439 C Because of periodicity of the dependence of the SC energy in omega we have
5440 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5441 C To avoid underflows, first compute & store the exponents.
5449 z(k)=x(k)-censc(k,j,it)
5454 Axk=Axk+gaussc(l,k,j,it)*z(l)
5460 expfac=expfac+Ax(k,j,iii)*z(k)
5468 C As in the case of ebend, we want to avoid underflows in exponentiation and
5469 C subsequent NaNs and INFs in energy calculation.
5470 C Find the largest exponent
5474 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5478 cd print *,'it=',it,' emin=',emin
5480 C Compute the contribution to SC energy and derivatives
5484 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5485 cd print *,'j=',j,' expfac=',expfac
5486 escloc_i=escloc_i+expfac
5488 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5492 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5493 & +gaussc(k,2,j,it))*expfac
5500 dersc(1)=dersc(1)/cos(theti)**2
5501 ddersc(1)=ddersc(1)/cos(theti)**2
5504 escloci=-(dlog(escloc_i)-emin)
5506 dersc(j)=dersc(j)/escloc_i
5510 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5515 C------------------------------------------------------------------------------
5516 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5517 implicit real*8 (a-h,o-z)
5518 include 'DIMENSIONS'
5519 include 'COMMON.GEO'
5520 include 'COMMON.LOCAL'
5521 include 'COMMON.IOUNITS'
5522 common /sccalc/ time11,time12,time112,theti,it,nlobit
5523 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5524 double precision contr(maxlob)
5535 z(k)=x(k)-censc(k,j,it)
5541 Axk=Axk+gaussc(l,k,j,it)*z(l)
5547 expfac=expfac+Ax(k,j)*z(k)
5552 C As in the case of ebend, we want to avoid underflows in exponentiation and
5553 C subsequent NaNs and INFs in energy calculation.
5554 C Find the largest exponent
5557 if (emin.gt.contr(j)) emin=contr(j)
5561 C Compute the contribution to SC energy and derivatives
5565 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5566 escloc_i=escloc_i+expfac
5568 dersc(k)=dersc(k)+Ax(k,j)*expfac
5570 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5571 & +gaussc(1,2,j,it))*expfac
5575 dersc(1)=dersc(1)/cos(theti)**2
5576 dersc12=dersc12/cos(theti)**2
5577 escloci=-(dlog(escloc_i)-emin)
5579 dersc(j)=dersc(j)/escloc_i
5581 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5585 c----------------------------------------------------------------------------------
5586 subroutine esc(escloc)
5587 C Calculate the local energy of a side chain and its derivatives in the
5588 C corresponding virtual-bond valence angles THETA and the spherical angles
5589 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5590 C added by Urszula Kozlowska. 07/11/2007
5592 implicit real*8 (a-h,o-z)
5593 include 'DIMENSIONS'
5594 include 'DIMENSIONS.ZSCOPT'
5595 include 'COMMON.GEO'
5596 include 'COMMON.LOCAL'
5597 include 'COMMON.VAR'
5598 include 'COMMON.SCROT'
5599 include 'COMMON.INTERACT'
5600 include 'COMMON.DERIV'
5601 include 'COMMON.CHAIN'
5602 include 'COMMON.IOUNITS'
5603 include 'COMMON.NAMES'
5604 include 'COMMON.FFIELD'
5605 include 'COMMON.CONTROL'
5606 include 'COMMON.VECTORS'
5607 double precision x_prime(3),y_prime(3),z_prime(3)
5608 & , sumene,dsc_i,dp2_i,x(65),
5609 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5610 & de_dxx,de_dyy,de_dzz,de_dt
5611 double precision s1_t,s1_6_t,s2_t,s2_6_t
5613 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5614 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5615 & dt_dCi(3),dt_dCi1(3)
5616 common /sccalc/ time11,time12,time112,theti,it,nlobit
5619 do i=loc_start,loc_end
5620 costtab(i+1) =dcos(theta(i+1))
5621 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5622 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5623 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5624 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5625 cosfac=dsqrt(cosfac2)
5626 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5627 sinfac=dsqrt(sinfac2)
5629 if (it.eq.10) goto 1
5631 C Compute the axes of tghe local cartesian coordinates system; store in
5632 c x_prime, y_prime and z_prime
5639 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5640 C & dc_norm(3,i+nres)
5642 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5643 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5646 z_prime(j) = -uz(j,i-1)
5649 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5650 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5651 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5652 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5653 c & " xy",scalar(x_prime(1),y_prime(1)),
5654 c & " xz",scalar(x_prime(1),z_prime(1)),
5655 c & " yy",scalar(y_prime(1),y_prime(1)),
5656 c & " yz",scalar(y_prime(1),z_prime(1)),
5657 c & " zz",scalar(z_prime(1),z_prime(1))
5659 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5660 C to local coordinate system. Store in xx, yy, zz.
5666 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5667 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5668 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5675 C Compute the energy of the ith side cbain
5677 c write (2,*) "xx",xx," yy",yy," zz",zz
5680 x(j) = sc_parmin(j,it)
5683 Cc diagnostics - remove later
5685 yy1 = dsin(alph(2))*dcos(omeg(2))
5686 zz1 = -dsin(alph(2))*dsin(omeg(2))
5687 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5688 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5690 C," --- ", xx_w,yy_w,zz_w
5693 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5694 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5696 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5697 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5699 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5700 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5701 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5702 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5703 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5705 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5706 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5707 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5708 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5709 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5711 dsc_i = 0.743d0+x(61)
5713 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5714 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5715 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5716 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5717 s1=(1+x(63))/(0.1d0 + dscp1)
5718 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5719 s2=(1+x(65))/(0.1d0 + dscp2)
5720 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5721 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5722 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5723 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5725 c & dscp1,dscp2,sumene
5726 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5727 escloc = escloc + sumene
5728 c write (2,*) "escloc",escloc
5729 if (.not. calc_grad) goto 1
5732 C This section to check the numerical derivatives of the energy of ith side
5733 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5734 C #define DEBUG in the code to turn it on.
5736 write (2,*) "sumene =",sumene
5740 write (2,*) xx,yy,zz
5741 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5742 de_dxx_num=(sumenep-sumene)/aincr
5744 write (2,*) "xx+ sumene from enesc=",sumenep
5747 write (2,*) xx,yy,zz
5748 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5749 de_dyy_num=(sumenep-sumene)/aincr
5751 write (2,*) "yy+ sumene from enesc=",sumenep
5754 write (2,*) xx,yy,zz
5755 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5756 de_dzz_num=(sumenep-sumene)/aincr
5758 write (2,*) "zz+ sumene from enesc=",sumenep
5759 costsave=cost2tab(i+1)
5760 sintsave=sint2tab(i+1)
5761 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5762 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5763 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5764 de_dt_num=(sumenep-sumene)/aincr
5765 write (2,*) " t+ sumene from enesc=",sumenep
5766 cost2tab(i+1)=costsave
5767 sint2tab(i+1)=sintsave
5768 C End of diagnostics section.
5771 C Compute the gradient of esc
5773 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5774 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5775 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5776 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5777 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5778 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5779 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5780 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5781 pom1=(sumene3*sint2tab(i+1)+sumene1)
5782 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5783 pom2=(sumene4*cost2tab(i+1)+sumene2)
5784 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5785 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5786 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5787 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5789 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5790 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5791 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5793 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5794 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5795 & +(pom1+pom2)*pom_dx
5797 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5800 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5801 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5802 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5804 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5805 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5806 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5807 & +x(59)*zz**2 +x(60)*xx*zz
5808 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5809 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5810 & +(pom1-pom2)*pom_dy
5812 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5815 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5816 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5817 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5818 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5819 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5820 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5821 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5822 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5824 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5827 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5828 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5829 & +pom1*pom_dt1+pom2*pom_dt2
5831 write(2,*), "de_dt = ", de_dt,de_dt_num
5835 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5836 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5837 cosfac2xx=cosfac2*xx
5838 sinfac2yy=sinfac2*yy
5840 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5842 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5844 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5845 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5846 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5847 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5848 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5849 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5850 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5851 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5852 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5853 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5857 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5858 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5861 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5862 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5863 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5865 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5866 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5870 dXX_Ctab(k,i)=dXX_Ci(k)
5871 dXX_C1tab(k,i)=dXX_Ci1(k)
5872 dYY_Ctab(k,i)=dYY_Ci(k)
5873 dYY_C1tab(k,i)=dYY_Ci1(k)
5874 dZZ_Ctab(k,i)=dZZ_Ci(k)
5875 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5876 dXX_XYZtab(k,i)=dXX_XYZ(k)
5877 dYY_XYZtab(k,i)=dYY_XYZ(k)
5878 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5882 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5883 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5884 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5885 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5886 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5888 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5889 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5890 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5891 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5892 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5893 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5894 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5895 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5897 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5898 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5900 C to check gradient call subroutine check_grad
5907 c------------------------------------------------------------------------------
5908 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5910 C This procedure calculates two-body contact function g(rij) and its derivative:
5913 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5916 C where x=(rij-r0ij)/delta
5918 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5921 double precision rij,r0ij,eps0ij,fcont,fprimcont
5922 double precision x,x2,x4,delta
5926 if (x.lt.-1.0D0) then
5929 else if (x.le.1.0D0) then
5932 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5933 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5940 c------------------------------------------------------------------------------
5941 subroutine splinthet(theti,delta,ss,ssder)
5942 implicit real*8 (a-h,o-z)
5943 include 'DIMENSIONS'
5944 include 'DIMENSIONS.ZSCOPT'
5945 include 'COMMON.VAR'
5946 include 'COMMON.GEO'
5949 if (theti.gt.pipol) then
5950 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5952 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5957 c------------------------------------------------------------------------------
5958 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5960 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5961 double precision ksi,ksi2,ksi3,a1,a2,a3
5962 a1=fprim0*delta/(f1-f0)
5968 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5969 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5972 c------------------------------------------------------------------------------
5973 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5975 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5976 double precision ksi,ksi2,ksi3,a1,a2,a3
5981 a2=3*(f1x-f0x)-2*fprim0x*delta
5982 a3=fprim0x*delta-2*(f1x-f0x)
5983 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5986 C-----------------------------------------------------------------------------
5988 C-----------------------------------------------------------------------------
5989 subroutine etor(etors,edihcnstr,fact)
5990 implicit real*8 (a-h,o-z)
5991 include 'DIMENSIONS'
5992 include 'DIMENSIONS.ZSCOPT'
5993 include 'COMMON.VAR'
5994 include 'COMMON.GEO'
5995 include 'COMMON.LOCAL'
5996 include 'COMMON.TORSION'
5997 include 'COMMON.INTERACT'
5998 include 'COMMON.DERIV'
5999 include 'COMMON.CHAIN'
6000 include 'COMMON.NAMES'
6001 include 'COMMON.IOUNITS'
6002 include 'COMMON.FFIELD'
6003 include 'COMMON.TORCNSTR'
6005 C Set lprn=.true. for debugging
6009 do i=iphi_start,iphi_end
6010 itori=itortyp(itype(i-2))
6011 itori1=itortyp(itype(i-1))
6014 C Proline-Proline pair is a special case...
6015 if (itori.eq.3 .and. itori1.eq.3) then
6016 if (phii.gt.-dwapi3) then
6018 fac=1.0D0/(1.0D0-cosphi)
6019 etorsi=v1(1,3,3)*fac
6020 etorsi=etorsi+etorsi
6021 etors=etors+etorsi-v1(1,3,3)
6022 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6025 v1ij=v1(j+1,itori,itori1)
6026 v2ij=v2(j+1,itori,itori1)
6029 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6030 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6034 v1ij=v1(j,itori,itori1)
6035 v2ij=v2(j,itori,itori1)
6038 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6039 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6043 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6044 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6045 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6046 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6047 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6049 ! 6/20/98 - dihedral angle constraints
6052 itori=idih_constr(i)
6055 if (difi.gt.drange(i)) then
6057 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6058 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6059 else if (difi.lt.-drange(i)) then
6061 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6062 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6064 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6065 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6067 ! write (iout,*) 'edihcnstr',edihcnstr
6070 c------------------------------------------------------------------------------
6072 subroutine etor(etors,edihcnstr,fact)
6073 implicit real*8 (a-h,o-z)
6074 include 'DIMENSIONS'
6075 include 'DIMENSIONS.ZSCOPT'
6076 include 'COMMON.VAR'
6077 include 'COMMON.GEO'
6078 include 'COMMON.LOCAL'
6079 include 'COMMON.TORSION'
6080 include 'COMMON.INTERACT'
6081 include 'COMMON.DERIV'
6082 include 'COMMON.CHAIN'
6083 include 'COMMON.NAMES'
6084 include 'COMMON.IOUNITS'
6085 include 'COMMON.FFIELD'
6086 include 'COMMON.TORCNSTR'
6088 C Set lprn=.true. for debugging
6092 do i=iphi_start,iphi_end
6093 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6094 itori=itortyp(itype(i-2))
6095 itori1=itortyp(itype(i-1))
6098 C Regular cosine and sine terms
6099 do j=1,nterm(itori,itori1)
6100 v1ij=v1(j,itori,itori1)
6101 v2ij=v2(j,itori,itori1)
6104 etors=etors+v1ij*cosphi+v2ij*sinphi
6105 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6109 C E = SUM ----------------------------------- - v1
6110 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6112 cosphi=dcos(0.5d0*phii)
6113 sinphi=dsin(0.5d0*phii)
6114 do j=1,nlor(itori,itori1)
6115 vl1ij=vlor1(j,itori,itori1)
6116 vl2ij=vlor2(j,itori,itori1)
6117 vl3ij=vlor3(j,itori,itori1)
6118 pom=vl2ij*cosphi+vl3ij*sinphi
6119 pom1=1.0d0/(pom*pom+1.0d0)
6120 etors=etors+vl1ij*pom1
6122 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6124 C Subtract the constant term
6125 etors=etors-v0(itori,itori1)
6127 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6128 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6129 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6130 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6131 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6134 ! 6/20/98 - dihedral angle constraints
6137 itori=idih_constr(i)
6139 difi=pinorm(phii-phi0(i))
6141 if (difi.gt.drange(i)) then
6143 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6144 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6145 edihi=0.25d0*ftors*difi**4
6146 else if (difi.lt.-drange(i)) then
6148 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6149 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6150 edihi=0.25d0*ftors*difi**4
6154 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
6156 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6157 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6159 ! write (iout,*) 'edihcnstr',edihcnstr
6162 c----------------------------------------------------------------------------
6163 subroutine etor_d(etors_d,fact2)
6164 C 6/23/01 Compute double torsional energy
6165 implicit real*8 (a-h,o-z)
6166 include 'DIMENSIONS'
6167 include 'DIMENSIONS.ZSCOPT'
6168 include 'COMMON.VAR'
6169 include 'COMMON.GEO'
6170 include 'COMMON.LOCAL'
6171 include 'COMMON.TORSION'
6172 include 'COMMON.INTERACT'
6173 include 'COMMON.DERIV'
6174 include 'COMMON.CHAIN'
6175 include 'COMMON.NAMES'
6176 include 'COMMON.IOUNITS'
6177 include 'COMMON.FFIELD'
6178 include 'COMMON.TORCNSTR'
6180 C Set lprn=.true. for debugging
6184 do i=iphi_start,iphi_end-1
6185 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6187 itori=itortyp(itype(i-2))
6188 itori1=itortyp(itype(i-1))
6189 itori2=itortyp(itype(i))
6194 C Regular cosine and sine terms
6195 do j=1,ntermd_1(itori,itori1,itori2)
6196 v1cij=v1c(1,j,itori,itori1,itori2)
6197 v1sij=v1s(1,j,itori,itori1,itori2)
6198 v2cij=v1c(2,j,itori,itori1,itori2)
6199 v2sij=v1s(2,j,itori,itori1,itori2)
6200 cosphi1=dcos(j*phii)
6201 sinphi1=dsin(j*phii)
6202 cosphi2=dcos(j*phii1)
6203 sinphi2=dsin(j*phii1)
6204 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6205 & v2cij*cosphi2+v2sij*sinphi2
6206 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6207 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6209 do k=2,ntermd_2(itori,itori1,itori2)
6211 v1cdij = v2c(k,l,itori,itori1,itori2)
6212 v2cdij = v2c(l,k,itori,itori1,itori2)
6213 v1sdij = v2s(k,l,itori,itori1,itori2)
6214 v2sdij = v2s(l,k,itori,itori1,itori2)
6215 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6216 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6217 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6218 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6219 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6220 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6221 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6222 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6223 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6224 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6227 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6228 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6234 c------------------------------------------------------------------------------
6235 subroutine eback_sc_corr(esccor)
6236 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6237 c conformational states; temporarily implemented as differences
6238 c between UNRES torsional potentials (dependent on three types of
6239 c residues) and the torsional potentials dependent on all 20 types
6240 c of residues computed from AM1 energy surfaces of terminally-blocked
6241 c amino-acid residues.
6242 implicit real*8 (a-h,o-z)
6243 include 'DIMENSIONS'
6244 include 'DIMENSIONS.ZSCOPT'
6245 include 'COMMON.VAR'
6246 include 'COMMON.GEO'
6247 include 'COMMON.LOCAL'
6248 include 'COMMON.TORSION'
6249 include 'COMMON.SCCOR'
6250 include 'COMMON.INTERACT'
6251 include 'COMMON.DERIV'
6252 include 'COMMON.CHAIN'
6253 include 'COMMON.NAMES'
6254 include 'COMMON.IOUNITS'
6255 include 'COMMON.FFIELD'
6256 include 'COMMON.CONTROL'
6258 C Set lprn=.true. for debugging
6261 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
6263 do i=itau_start,itau_end
6265 isccori=isccortyp(itype(i-2))
6266 isccori1=isccortyp(itype(i-1))
6268 cccc Added 9 May 2012
6269 cc Tauangle is torsional engle depending on the value of first digit
6270 c(see comment below)
6271 cc Omicron is flat angle depending on the value of first digit
6272 c(see comment below)
6275 do intertyp=1,3 !intertyp
6276 cc Added 09 May 2012 (Adasko)
6277 cc Intertyp means interaction type of backbone mainchain correlation:
6278 c 1 = SC...Ca...Ca...Ca
6279 c 2 = Ca...Ca...Ca...SC
6280 c 3 = SC...Ca...Ca...SCi
6282 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6283 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6284 & (itype(i-1).eq.21)))
6285 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6286 & .or.(itype(i-2).eq.21)))
6287 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6288 & (itype(i-1).eq.21)))) cycle
6289 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6290 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6292 do j=1,nterm_sccor(isccori,isccori1)
6293 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6294 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6295 cosphi=dcos(j*tauangle(intertyp,i))
6296 sinphi=dsin(j*tauangle(intertyp,i))
6297 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6298 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6300 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6301 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6302 c &gloc_sc(intertyp,i-3,icg)
6304 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6305 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6306 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6307 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6308 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6312 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6316 c------------------------------------------------------------------------------
6317 subroutine multibody(ecorr)
6318 C This subroutine calculates multi-body contributions to energy following
6319 C the idea of Skolnick et al. If side chains I and J make a contact and
6320 C at the same time side chains I+1 and J+1 make a contact, an extra
6321 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6322 implicit real*8 (a-h,o-z)
6323 include 'DIMENSIONS'
6324 include 'COMMON.IOUNITS'
6325 include 'COMMON.DERIV'
6326 include 'COMMON.INTERACT'
6327 include 'COMMON.CONTACTS'
6328 double precision gx(3),gx1(3)
6331 C Set lprn=.true. for debugging
6335 write (iout,'(a)') 'Contact function values:'
6337 write (iout,'(i2,20(1x,i2,f10.5))')
6338 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6353 num_conti=num_cont(i)
6354 num_conti1=num_cont(i1)
6359 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6360 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6361 cd & ' ishift=',ishift
6362 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6363 C The system gains extra energy.
6364 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6365 endif ! j1==j+-ishift
6374 c------------------------------------------------------------------------------
6375 double precision function esccorr(i,j,k,l,jj,kk)
6376 implicit real*8 (a-h,o-z)
6377 include 'DIMENSIONS'
6378 include 'COMMON.IOUNITS'
6379 include 'COMMON.DERIV'
6380 include 'COMMON.INTERACT'
6381 include 'COMMON.CONTACTS'
6382 double precision gx(3),gx1(3)
6387 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6388 C Calculate the multi-body contribution to energy.
6389 C Calculate multi-body contributions to the gradient.
6390 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6391 cd & k,l,(gacont(m,kk,k),m=1,3)
6393 gx(m) =ekl*gacont(m,jj,i)
6394 gx1(m)=eij*gacont(m,kk,k)
6395 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6396 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6397 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6398 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6402 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6407 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6413 c------------------------------------------------------------------------------
6415 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
6416 implicit real*8 (a-h,o-z)
6417 include 'DIMENSIONS'
6418 integer dimen1,dimen2,atom,indx
6419 double precision buffer(dimen1,dimen2)
6420 double precision zapas
6421 common /contacts_hb/ zapas(3,20,maxres,7),
6422 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6423 & num_cont_hb(maxres),jcont_hb(20,maxres)
6424 num_kont=num_cont_hb(atom)
6428 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
6431 buffer(i,indx+22)=facont_hb(i,atom)
6432 buffer(i,indx+23)=ees0p(i,atom)
6433 buffer(i,indx+24)=ees0m(i,atom)
6434 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
6436 buffer(1,indx+26)=dfloat(num_kont)
6439 c------------------------------------------------------------------------------
6440 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
6441 implicit real*8 (a-h,o-z)
6442 include 'DIMENSIONS'
6443 integer dimen1,dimen2,atom,indx
6444 double precision buffer(dimen1,dimen2)
6445 double precision zapas
6446 common /contacts_hb/ zapas(3,20,maxres,7),
6447 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6448 & num_cont_hb(maxres),jcont_hb(20,maxres)
6449 num_kont=buffer(1,indx+26)
6450 num_kont_old=num_cont_hb(atom)
6451 num_cont_hb(atom)=num_kont+num_kont_old
6456 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
6459 facont_hb(ii,atom)=buffer(i,indx+22)
6460 ees0p(ii,atom)=buffer(i,indx+23)
6461 ees0m(ii,atom)=buffer(i,indx+24)
6462 jcont_hb(ii,atom)=buffer(i,indx+25)
6466 c------------------------------------------------------------------------------
6468 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6469 C This subroutine calculates multi-body contributions to hydrogen-bonding
6470 implicit real*8 (a-h,o-z)
6471 include 'DIMENSIONS'
6472 include 'DIMENSIONS.ZSCOPT'
6473 include 'COMMON.IOUNITS'
6475 include 'COMMON.INFO'
6477 include 'COMMON.FFIELD'
6478 include 'COMMON.DERIV'
6479 include 'COMMON.INTERACT'
6480 include 'COMMON.CONTACTS'
6482 parameter (max_cont=maxconts)
6483 parameter (max_dim=2*(8*3+2))
6484 parameter (msglen1=max_cont*max_dim*4)
6485 parameter (msglen2=2*msglen1)
6486 integer source,CorrelType,CorrelID,Error
6487 double precision buffer(max_cont,max_dim)
6489 double precision gx(3),gx1(3)
6492 C Set lprn=.true. for debugging
6497 if (fgProcs.le.1) goto 30
6499 write (iout,'(a)') 'Contact function values:'
6501 write (iout,'(2i3,50(1x,i2,f5.2))')
6502 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6503 & j=1,num_cont_hb(i))
6506 C Caution! Following code assumes that electrostatic interactions concerning
6507 C a given atom are split among at most two processors!
6517 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6520 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6521 if (MyRank.gt.0) then
6522 C Send correlation contributions to the preceding processor
6524 nn=num_cont_hb(iatel_s)
6525 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6526 cd write (iout,*) 'The BUFFER array:'
6528 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6530 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6532 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6533 C Clear the contacts of the atom passed to the neighboring processor
6534 nn=num_cont_hb(iatel_s+1)
6536 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6538 num_cont_hb(iatel_s)=0
6540 cd write (iout,*) 'Processor ',MyID,MyRank,
6541 cd & ' is sending correlation contribution to processor',MyID-1,
6542 cd & ' msglen=',msglen
6543 cd write (*,*) 'Processor ',MyID,MyRank,
6544 cd & ' is sending correlation contribution to processor',MyID-1,
6545 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6546 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6547 cd write (iout,*) 'Processor ',MyID,
6548 cd & ' has sent correlation contribution to processor',MyID-1,
6549 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6550 cd write (*,*) 'Processor ',MyID,
6551 cd & ' has sent correlation contribution to processor',MyID-1,
6552 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6554 endif ! (MyRank.gt.0)
6558 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6559 if (MyRank.lt.fgProcs-1) then
6560 C Receive correlation contributions from the next processor
6562 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6563 cd write (iout,*) 'Processor',MyID,
6564 cd & ' is receiving correlation contribution from processor',MyID+1,
6565 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6566 cd write (*,*) 'Processor',MyID,
6567 cd & ' is receiving correlation contribution from processor',MyID+1,
6568 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6570 do while (nbytes.le.0)
6571 call mp_probe(MyID+1,CorrelType,nbytes)
6573 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6574 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6575 cd write (iout,*) 'Processor',MyID,
6576 cd & ' has received correlation contribution from processor',MyID+1,
6577 cd & ' msglen=',msglen,' nbytes=',nbytes
6578 cd write (iout,*) 'The received BUFFER array:'
6580 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6582 if (msglen.eq.msglen1) then
6583 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6584 else if (msglen.eq.msglen2) then
6585 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6586 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6589 & 'ERROR!!!! message length changed while processing correlations.'
6591 & 'ERROR!!!! message length changed while processing correlations.'
6592 call mp_stopall(Error)
6593 endif ! msglen.eq.msglen1
6594 endif ! MyRank.lt.fgProcs-1
6601 write (iout,'(a)') 'Contact function values:'
6603 write (iout,'(2i3,50(1x,i2,f5.2))')
6604 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6605 & j=1,num_cont_hb(i))
6609 C Remove the loop below after debugging !!!
6616 C Calculate the local-electrostatic correlation terms
6617 do i=iatel_s,iatel_e+1
6619 num_conti=num_cont_hb(i)
6620 num_conti1=num_cont_hb(i+1)
6625 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6626 c & ' jj=',jj,' kk=',kk
6627 if (j1.eq.j+1 .or. j1.eq.j-1) then
6628 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6629 C The system gains extra energy.
6630 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6632 else if (j1.eq.j) then
6633 C Contacts I-J and I-(J+1) occur simultaneously.
6634 C The system loses extra energy.
6635 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6640 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6641 c & ' jj=',jj,' kk=',kk
6643 C Contacts I-J and (I+1)-J occur simultaneously.
6644 C The system loses extra energy.
6645 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6652 c------------------------------------------------------------------------------
6653 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6655 C This subroutine calculates multi-body contributions to hydrogen-bonding
6656 implicit real*8 (a-h,o-z)
6657 include 'DIMENSIONS'
6658 include 'DIMENSIONS.ZSCOPT'
6659 include 'COMMON.IOUNITS'
6661 include 'COMMON.INFO'
6663 include 'COMMON.FFIELD'
6664 include 'COMMON.DERIV'
6665 include 'COMMON.INTERACT'
6666 include 'COMMON.CONTACTS'
6668 parameter (max_cont=maxconts)
6669 parameter (max_dim=2*(8*3+2))
6670 parameter (msglen1=max_cont*max_dim*4)
6671 parameter (msglen2=2*msglen1)
6672 integer source,CorrelType,CorrelID,Error
6673 double precision buffer(max_cont,max_dim)
6675 double precision gx(3),gx1(3)
6678 C Set lprn=.true. for debugging
6684 if (fgProcs.le.1) goto 30
6686 write (iout,'(a)') 'Contact function values:'
6688 write (iout,'(2i3,50(1x,i2,f5.2))')
6689 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6690 & j=1,num_cont_hb(i))
6693 C Caution! Following code assumes that electrostatic interactions concerning
6694 C a given atom are split among at most two processors!
6704 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6707 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6708 if (MyRank.gt.0) then
6709 C Send correlation contributions to the preceding processor
6711 nn=num_cont_hb(iatel_s)
6712 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6713 cd write (iout,*) 'The BUFFER array:'
6715 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6717 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6719 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6720 C Clear the contacts of the atom passed to the neighboring processor
6721 nn=num_cont_hb(iatel_s+1)
6723 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6725 num_cont_hb(iatel_s)=0
6727 cd write (iout,*) 'Processor ',MyID,MyRank,
6728 cd & ' is sending correlation contribution to processor',MyID-1,
6729 cd & ' msglen=',msglen
6730 cd write (*,*) 'Processor ',MyID,MyRank,
6731 cd & ' is sending correlation contribution to processor',MyID-1,
6732 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6733 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6734 cd write (iout,*) 'Processor ',MyID,
6735 cd & ' has sent correlation contribution to processor',MyID-1,
6736 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6737 cd write (*,*) 'Processor ',MyID,
6738 cd & ' has sent correlation contribution to processor',MyID-1,
6739 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6741 endif ! (MyRank.gt.0)
6745 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6746 if (MyRank.lt.fgProcs-1) then
6747 C Receive correlation contributions from the next processor
6749 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6750 cd write (iout,*) 'Processor',MyID,
6751 cd & ' is receiving correlation contribution from processor',MyID+1,
6752 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6753 cd write (*,*) 'Processor',MyID,
6754 cd & ' is receiving correlation contribution from processor',MyID+1,
6755 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6757 do while (nbytes.le.0)
6758 call mp_probe(MyID+1,CorrelType,nbytes)
6760 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6761 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6762 cd write (iout,*) 'Processor',MyID,
6763 cd & ' has received correlation contribution from processor',MyID+1,
6764 cd & ' msglen=',msglen,' nbytes=',nbytes
6765 cd write (iout,*) 'The received BUFFER array:'
6767 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6769 if (msglen.eq.msglen1) then
6770 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6771 else if (msglen.eq.msglen2) then
6772 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6773 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6776 & 'ERROR!!!! message length changed while processing correlations.'
6778 & 'ERROR!!!! message length changed while processing correlations.'
6779 call mp_stopall(Error)
6780 endif ! msglen.eq.msglen1
6781 endif ! MyRank.lt.fgProcs-1
6788 write (iout,'(a)') 'Contact function values:'
6790 write (iout,'(2i3,50(1x,i2,f5.2))')
6791 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6792 & j=1,num_cont_hb(i))
6798 C Remove the loop below after debugging !!!
6805 C Calculate the dipole-dipole interaction energies
6806 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6807 do i=iatel_s,iatel_e+1
6808 num_conti=num_cont_hb(i)
6815 C Calculate the local-electrostatic correlation terms
6816 do i=iatel_s,iatel_e+1
6818 num_conti=num_cont_hb(i)
6819 num_conti1=num_cont_hb(i+1)
6824 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6825 c & ' jj=',jj,' kk=',kk
6826 if (j1.eq.j+1 .or. j1.eq.j-1) then
6827 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6828 C The system gains extra energy.
6830 sqd1=dsqrt(d_cont(jj,i))
6831 sqd2=dsqrt(d_cont(kk,i1))
6832 sred_geom = sqd1*sqd2
6833 IF (sred_geom.lt.cutoff_corr) THEN
6834 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6836 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6837 c & ' jj=',jj,' kk=',kk
6838 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6839 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6841 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6842 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6845 cd write (iout,*) 'sred_geom=',sred_geom,
6846 cd & ' ekont=',ekont,' fprim=',fprimcont
6847 call calc_eello(i,j,i+1,j1,jj,kk)
6848 if (wcorr4.gt.0.0d0)
6849 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6850 if (wcorr5.gt.0.0d0)
6851 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6852 c print *,"wcorr5",ecorr5
6853 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6854 cd write(2,*)'ijkl',i,j,i+1,j1
6855 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6856 & .or. wturn6.eq.0.0d0))then
6857 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6858 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6859 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6860 cd & 'ecorr6=',ecorr6
6861 cd write (iout,'(4e15.5)') sred_geom,
6862 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6863 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6864 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6865 else if (wturn6.gt.0.0d0
6866 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6867 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6868 eturn6=eturn6+eello_turn6(i,jj,kk)
6869 cd write (2,*) 'multibody_eello:eturn6',eturn6
6873 else if (j1.eq.j) then
6874 C Contacts I-J and I-(J+1) occur simultaneously.
6875 C The system loses extra energy.
6876 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6881 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6882 c & ' jj=',jj,' kk=',kk
6884 C Contacts I-J and (I+1)-J occur simultaneously.
6885 C The system loses extra energy.
6886 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6893 c------------------------------------------------------------------------------
6894 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6895 implicit real*8 (a-h,o-z)
6896 include 'DIMENSIONS'
6897 include 'COMMON.IOUNITS'
6898 include 'COMMON.DERIV'
6899 include 'COMMON.INTERACT'
6900 include 'COMMON.CONTACTS'
6901 double precision gx(3),gx1(3)
6911 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6912 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6913 C Following 4 lines for diagnostics.
6918 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6920 c write (iout,*)'Contacts have occurred for peptide groups',
6921 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6922 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6923 C Calculate the multi-body contribution to energy.
6924 ecorr=ecorr+ekont*ees
6926 C Calculate multi-body contributions to the gradient.
6928 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6929 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6930 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6931 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6932 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6933 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6934 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6935 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6936 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6937 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6938 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6939 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6940 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6941 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6945 gradcorr(ll,m)=gradcorr(ll,m)+
6946 & ees*ekl*gacont_hbr(ll,jj,i)-
6947 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6948 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6953 gradcorr(ll,m)=gradcorr(ll,m)+
6954 & ees*eij*gacont_hbr(ll,kk,k)-
6955 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6956 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6963 C---------------------------------------------------------------------------
6964 subroutine dipole(i,j,jj)
6965 implicit real*8 (a-h,o-z)
6966 include 'DIMENSIONS'
6967 include 'DIMENSIONS.ZSCOPT'
6968 include 'COMMON.IOUNITS'
6969 include 'COMMON.CHAIN'
6970 include 'COMMON.FFIELD'
6971 include 'COMMON.DERIV'
6972 include 'COMMON.INTERACT'
6973 include 'COMMON.CONTACTS'
6974 include 'COMMON.TORSION'
6975 include 'COMMON.VAR'
6976 include 'COMMON.GEO'
6977 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6979 iti1 = itortyp(itype(i+1))
6980 if (j.lt.nres-1) then
6981 itj1 = itortyp(itype(j+1))
6986 dipi(iii,1)=Ub2(iii,i)
6987 dipderi(iii)=Ub2der(iii,i)
6988 dipi(iii,2)=b1(iii,iti1)
6989 dipj(iii,1)=Ub2(iii,j)
6990 dipderj(iii)=Ub2der(iii,j)
6991 dipj(iii,2)=b1(iii,itj1)
6995 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6998 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7001 if (.not.calc_grad) return
7006 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7010 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7015 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7016 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7018 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7020 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7022 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7026 C---------------------------------------------------------------------------
7027 subroutine calc_eello(i,j,k,l,jj,kk)
7029 C This subroutine computes matrices and vectors needed to calculate
7030 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7032 implicit real*8 (a-h,o-z)
7033 include 'DIMENSIONS'
7034 include 'DIMENSIONS.ZSCOPT'
7035 include 'COMMON.IOUNITS'
7036 include 'COMMON.CHAIN'
7037 include 'COMMON.DERIV'
7038 include 'COMMON.INTERACT'
7039 include 'COMMON.CONTACTS'
7040 include 'COMMON.TORSION'
7041 include 'COMMON.VAR'
7042 include 'COMMON.GEO'
7043 include 'COMMON.FFIELD'
7044 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7045 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7048 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7049 cd & ' jj=',jj,' kk=',kk
7050 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7053 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7054 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7057 call transpose2(aa1(1,1),aa1t(1,1))
7058 call transpose2(aa2(1,1),aa2t(1,1))
7061 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7062 & aa1tder(1,1,lll,kkk))
7063 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7064 & aa2tder(1,1,lll,kkk))
7068 C parallel orientation of the two CA-CA-CA frames.
7070 iti=itortyp(itype(i))
7074 itk1=itortyp(itype(k+1))
7075 itj=itortyp(itype(j))
7076 if (l.lt.nres-1) then
7077 itl1=itortyp(itype(l+1))
7081 C A1 kernel(j+1) A2T
7083 cd write (iout,'(3f10.5,5x,3f10.5)')
7084 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7086 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7087 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7088 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7089 C Following matrices are needed only for 6-th order cumulants
7090 IF (wcorr6.gt.0.0d0) THEN
7091 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7092 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7093 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7094 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7095 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7096 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7097 & ADtEAderx(1,1,1,1,1,1))
7099 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7100 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7101 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7102 & ADtEA1derx(1,1,1,1,1,1))
7104 C End 6-th order cumulants
7107 cd write (2,*) 'In calc_eello6'
7109 cd write (2,*) 'iii=',iii
7111 cd write (2,*) 'kkk=',kkk
7113 cd write (2,'(3(2f10.5),5x)')
7114 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7119 call transpose2(EUgder(1,1,k),auxmat(1,1))
7120 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7121 call transpose2(EUg(1,1,k),auxmat(1,1))
7122 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7123 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7127 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7128 & EAEAderx(1,1,lll,kkk,iii,1))
7132 C A1T kernel(i+1) A2
7133 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7134 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7135 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7136 C Following matrices are needed only for 6-th order cumulants
7137 IF (wcorr6.gt.0.0d0) THEN
7138 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7139 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7140 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7141 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7142 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7143 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7144 & ADtEAderx(1,1,1,1,1,2))
7145 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7146 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7147 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7148 & ADtEA1derx(1,1,1,1,1,2))
7150 C End 6-th order cumulants
7151 call transpose2(EUgder(1,1,l),auxmat(1,1))
7152 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7153 call transpose2(EUg(1,1,l),auxmat(1,1))
7154 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7155 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7159 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7160 & EAEAderx(1,1,lll,kkk,iii,2))
7165 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7166 C They are needed only when the fifth- or the sixth-order cumulants are
7168 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7169 call transpose2(AEA(1,1,1),auxmat(1,1))
7170 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7171 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7172 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7173 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7174 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7175 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7176 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7177 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7178 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7179 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7180 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7181 call transpose2(AEA(1,1,2),auxmat(1,1))
7182 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7183 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7184 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7185 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7186 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7187 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7188 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7189 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7190 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7191 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7192 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7193 C Calculate the Cartesian derivatives of the vectors.
7197 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7198 call matvec2(auxmat(1,1),b1(1,iti),
7199 & AEAb1derx(1,lll,kkk,iii,1,1))
7200 call matvec2(auxmat(1,1),Ub2(1,i),
7201 & AEAb2derx(1,lll,kkk,iii,1,1))
7202 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7203 & AEAb1derx(1,lll,kkk,iii,2,1))
7204 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7205 & AEAb2derx(1,lll,kkk,iii,2,1))
7206 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7207 call matvec2(auxmat(1,1),b1(1,itj),
7208 & AEAb1derx(1,lll,kkk,iii,1,2))
7209 call matvec2(auxmat(1,1),Ub2(1,j),
7210 & AEAb2derx(1,lll,kkk,iii,1,2))
7211 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7212 & AEAb1derx(1,lll,kkk,iii,2,2))
7213 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7214 & AEAb2derx(1,lll,kkk,iii,2,2))
7221 C Antiparallel orientation of the two CA-CA-CA frames.
7223 iti=itortyp(itype(i))
7227 itk1=itortyp(itype(k+1))
7228 itl=itortyp(itype(l))
7229 itj=itortyp(itype(j))
7230 if (j.lt.nres-1) then
7231 itj1=itortyp(itype(j+1))
7235 C A2 kernel(j-1)T A1T
7236 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7237 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7238 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7239 C Following matrices are needed only for 6-th order cumulants
7240 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7241 & j.eq.i+4 .and. l.eq.i+3)) THEN
7242 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7243 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7244 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7245 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7246 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7247 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7248 & ADtEAderx(1,1,1,1,1,1))
7249 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7250 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7251 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7252 & ADtEA1derx(1,1,1,1,1,1))
7254 C End 6-th order cumulants
7255 call transpose2(EUgder(1,1,k),auxmat(1,1))
7256 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7257 call transpose2(EUg(1,1,k),auxmat(1,1))
7258 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7259 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7263 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7264 & EAEAderx(1,1,lll,kkk,iii,1))
7268 C A2T kernel(i+1)T A1
7269 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7270 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7271 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7272 C Following matrices are needed only for 6-th order cumulants
7273 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7274 & j.eq.i+4 .and. l.eq.i+3)) THEN
7275 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7276 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7277 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7278 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7279 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7280 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7281 & ADtEAderx(1,1,1,1,1,2))
7282 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7283 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7284 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7285 & ADtEA1derx(1,1,1,1,1,2))
7287 C End 6-th order cumulants
7288 call transpose2(EUgder(1,1,j),auxmat(1,1))
7289 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7290 call transpose2(EUg(1,1,j),auxmat(1,1))
7291 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7292 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7296 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7297 & EAEAderx(1,1,lll,kkk,iii,2))
7302 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7303 C They are needed only when the fifth- or the sixth-order cumulants are
7305 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7306 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7307 call transpose2(AEA(1,1,1),auxmat(1,1))
7308 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7309 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7310 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7311 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7312 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7313 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7314 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7315 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7316 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7317 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7318 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7319 call transpose2(AEA(1,1,2),auxmat(1,1))
7320 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7321 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7322 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7323 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7324 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7325 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7326 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7327 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7328 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7329 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7330 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7331 C Calculate the Cartesian derivatives of the vectors.
7335 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7336 call matvec2(auxmat(1,1),b1(1,iti),
7337 & AEAb1derx(1,lll,kkk,iii,1,1))
7338 call matvec2(auxmat(1,1),Ub2(1,i),
7339 & AEAb2derx(1,lll,kkk,iii,1,1))
7340 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7341 & AEAb1derx(1,lll,kkk,iii,2,1))
7342 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7343 & AEAb2derx(1,lll,kkk,iii,2,1))
7344 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7345 call matvec2(auxmat(1,1),b1(1,itl),
7346 & AEAb1derx(1,lll,kkk,iii,1,2))
7347 call matvec2(auxmat(1,1),Ub2(1,l),
7348 & AEAb2derx(1,lll,kkk,iii,1,2))
7349 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7350 & AEAb1derx(1,lll,kkk,iii,2,2))
7351 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7352 & AEAb2derx(1,lll,kkk,iii,2,2))
7361 C---------------------------------------------------------------------------
7362 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7363 & KK,KKderg,AKA,AKAderg,AKAderx)
7367 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7368 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7369 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7374 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7376 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7379 cd if (lprn) write (2,*) 'In kernel'
7381 cd if (lprn) write (2,*) 'kkk=',kkk
7383 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7384 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7386 cd write (2,*) 'lll=',lll
7387 cd write (2,*) 'iii=1'
7389 cd write (2,'(3(2f10.5),5x)')
7390 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7393 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7394 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7396 cd write (2,*) 'lll=',lll
7397 cd write (2,*) 'iii=2'
7399 cd write (2,'(3(2f10.5),5x)')
7400 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7407 C---------------------------------------------------------------------------
7408 double precision function eello4(i,j,k,l,jj,kk)
7409 implicit real*8 (a-h,o-z)
7410 include 'DIMENSIONS'
7411 include 'DIMENSIONS.ZSCOPT'
7412 include 'COMMON.IOUNITS'
7413 include 'COMMON.CHAIN'
7414 include 'COMMON.DERIV'
7415 include 'COMMON.INTERACT'
7416 include 'COMMON.CONTACTS'
7417 include 'COMMON.TORSION'
7418 include 'COMMON.VAR'
7419 include 'COMMON.GEO'
7420 double precision pizda(2,2),ggg1(3),ggg2(3)
7421 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7425 cd print *,'eello4:',i,j,k,l,jj,kk
7426 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7427 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7428 cold eij=facont_hb(jj,i)
7429 cold ekl=facont_hb(kk,k)
7431 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7433 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7434 gcorr_loc(k-1)=gcorr_loc(k-1)
7435 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7437 gcorr_loc(l-1)=gcorr_loc(l-1)
7438 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7440 gcorr_loc(j-1)=gcorr_loc(j-1)
7441 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7446 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7447 & -EAEAderx(2,2,lll,kkk,iii,1)
7448 cd derx(lll,kkk,iii)=0.0d0
7452 cd gcorr_loc(l-1)=0.0d0
7453 cd gcorr_loc(j-1)=0.0d0
7454 cd gcorr_loc(k-1)=0.0d0
7456 cd write (iout,*)'Contacts have occurred for peptide groups',
7457 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7458 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7459 if (j.lt.nres-1) then
7466 if (l.lt.nres-1) then
7474 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
7475 ggg1(ll)=eel4*g_contij(ll,1)
7476 ggg2(ll)=eel4*g_contij(ll,2)
7477 ghalf=0.5d0*ggg1(ll)
7479 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
7480 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7481 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
7482 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7483 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
7484 ghalf=0.5d0*ggg2(ll)
7486 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
7487 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7488 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
7489 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7494 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
7495 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7500 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
7501 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7507 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7512 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7516 cd write (2,*) iii,gcorr_loc(iii)
7520 cd write (2,*) 'ekont',ekont
7521 cd write (iout,*) 'eello4',ekont*eel4
7524 C---------------------------------------------------------------------------
7525 double precision function eello5(i,j,k,l,jj,kk)
7526 implicit real*8 (a-h,o-z)
7527 include 'DIMENSIONS'
7528 include 'DIMENSIONS.ZSCOPT'
7529 include 'COMMON.IOUNITS'
7530 include 'COMMON.CHAIN'
7531 include 'COMMON.DERIV'
7532 include 'COMMON.INTERACT'
7533 include 'COMMON.CONTACTS'
7534 include 'COMMON.TORSION'
7535 include 'COMMON.VAR'
7536 include 'COMMON.GEO'
7537 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7538 double precision ggg1(3),ggg2(3)
7539 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7544 C /l\ / \ \ / \ / \ / C
7545 C / \ / \ \ / \ / \ / C
7546 C j| o |l1 | o | o| o | | o |o C
7547 C \ |/k\| |/ \| / |/ \| |/ \| C
7548 C \i/ \ / \ / / \ / \ C
7550 C (I) (II) (III) (IV) C
7552 C eello5_1 eello5_2 eello5_3 eello5_4 C
7554 C Antiparallel chains C
7557 C /j\ / \ \ / \ / \ / C
7558 C / \ / \ \ / \ / \ / C
7559 C j1| o |l | o | o| o | | o |o C
7560 C \ |/k\| |/ \| / |/ \| |/ \| C
7561 C \i/ \ / \ / / \ / \ C
7563 C (I) (II) (III) (IV) C
7565 C eello5_1 eello5_2 eello5_3 eello5_4 C
7567 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7569 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7570 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7575 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7577 itk=itortyp(itype(k))
7578 itl=itortyp(itype(l))
7579 itj=itortyp(itype(j))
7584 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7585 cd & eel5_3_num,eel5_4_num)
7589 derx(lll,kkk,iii)=0.0d0
7593 cd eij=facont_hb(jj,i)
7594 cd ekl=facont_hb(kk,k)
7596 cd write (iout,*)'Contacts have occurred for peptide groups',
7597 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7599 C Contribution from the graph I.
7600 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7601 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7602 call transpose2(EUg(1,1,k),auxmat(1,1))
7603 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7604 vv(1)=pizda(1,1)-pizda(2,2)
7605 vv(2)=pizda(1,2)+pizda(2,1)
7606 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7607 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7609 C Explicit gradient in virtual-dihedral angles.
7610 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7611 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7612 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7613 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7614 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7615 vv(1)=pizda(1,1)-pizda(2,2)
7616 vv(2)=pizda(1,2)+pizda(2,1)
7617 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7618 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7619 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7620 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7621 vv(1)=pizda(1,1)-pizda(2,2)
7622 vv(2)=pizda(1,2)+pizda(2,1)
7624 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7625 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7626 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7628 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7629 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7630 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7632 C Cartesian gradient
7636 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7638 vv(1)=pizda(1,1)-pizda(2,2)
7639 vv(2)=pizda(1,2)+pizda(2,1)
7640 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7641 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7642 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7649 C Contribution from graph II
7650 call transpose2(EE(1,1,itk),auxmat(1,1))
7651 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7652 vv(1)=pizda(1,1)+pizda(2,2)
7653 vv(2)=pizda(2,1)-pizda(1,2)
7654 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7655 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7657 C Explicit gradient in virtual-dihedral angles.
7658 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7659 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7660 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7661 vv(1)=pizda(1,1)+pizda(2,2)
7662 vv(2)=pizda(2,1)-pizda(1,2)
7664 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7665 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7666 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7668 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7669 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7670 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7672 C Cartesian gradient
7676 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7678 vv(1)=pizda(1,1)+pizda(2,2)
7679 vv(2)=pizda(2,1)-pizda(1,2)
7680 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7681 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7682 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7691 C Parallel orientation
7692 C Contribution from graph III
7693 call transpose2(EUg(1,1,l),auxmat(1,1))
7694 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7695 vv(1)=pizda(1,1)-pizda(2,2)
7696 vv(2)=pizda(1,2)+pizda(2,1)
7697 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7698 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7700 C Explicit gradient in virtual-dihedral angles.
7701 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7702 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7703 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7704 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7705 vv(1)=pizda(1,1)-pizda(2,2)
7706 vv(2)=pizda(1,2)+pizda(2,1)
7707 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7708 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7709 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7710 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7711 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7712 vv(1)=pizda(1,1)-pizda(2,2)
7713 vv(2)=pizda(1,2)+pizda(2,1)
7714 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7715 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7716 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7717 C Cartesian gradient
7721 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7723 vv(1)=pizda(1,1)-pizda(2,2)
7724 vv(2)=pizda(1,2)+pizda(2,1)
7725 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7726 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7727 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7733 C Contribution from graph IV
7735 call transpose2(EE(1,1,itl),auxmat(1,1))
7736 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7737 vv(1)=pizda(1,1)+pizda(2,2)
7738 vv(2)=pizda(2,1)-pizda(1,2)
7739 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7740 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7742 C Explicit gradient in virtual-dihedral angles.
7743 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7744 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7745 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7746 vv(1)=pizda(1,1)+pizda(2,2)
7747 vv(2)=pizda(2,1)-pizda(1,2)
7748 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7749 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7750 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7751 C Cartesian gradient
7755 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7757 vv(1)=pizda(1,1)+pizda(2,2)
7758 vv(2)=pizda(2,1)-pizda(1,2)
7759 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7760 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7761 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7767 C Antiparallel orientation
7768 C Contribution from graph III
7770 call transpose2(EUg(1,1,j),auxmat(1,1))
7771 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7772 vv(1)=pizda(1,1)-pizda(2,2)
7773 vv(2)=pizda(1,2)+pizda(2,1)
7774 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7775 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7777 C Explicit gradient in virtual-dihedral angles.
7778 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7779 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7780 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7781 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7782 vv(1)=pizda(1,1)-pizda(2,2)
7783 vv(2)=pizda(1,2)+pizda(2,1)
7784 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7785 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7786 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7787 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7788 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7789 vv(1)=pizda(1,1)-pizda(2,2)
7790 vv(2)=pizda(1,2)+pizda(2,1)
7791 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7792 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7793 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7794 C Cartesian gradient
7798 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7800 vv(1)=pizda(1,1)-pizda(2,2)
7801 vv(2)=pizda(1,2)+pizda(2,1)
7802 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7803 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7804 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7810 C Contribution from graph IV
7812 call transpose2(EE(1,1,itj),auxmat(1,1))
7813 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7814 vv(1)=pizda(1,1)+pizda(2,2)
7815 vv(2)=pizda(2,1)-pizda(1,2)
7816 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7817 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7819 C Explicit gradient in virtual-dihedral angles.
7820 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7821 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7822 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7823 vv(1)=pizda(1,1)+pizda(2,2)
7824 vv(2)=pizda(2,1)-pizda(1,2)
7825 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7826 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7827 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7828 C Cartesian gradient
7832 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7834 vv(1)=pizda(1,1)+pizda(2,2)
7835 vv(2)=pizda(2,1)-pizda(1,2)
7836 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7837 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7838 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7845 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7846 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7847 cd write (2,*) 'ijkl',i,j,k,l
7848 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7849 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7851 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7852 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7853 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7854 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7856 if (j.lt.nres-1) then
7863 if (l.lt.nres-1) then
7873 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7875 ggg1(ll)=eel5*g_contij(ll,1)
7876 ggg2(ll)=eel5*g_contij(ll,2)
7877 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7878 ghalf=0.5d0*ggg1(ll)
7880 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7881 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7882 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7883 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7884 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7885 ghalf=0.5d0*ggg2(ll)
7887 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7888 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7889 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7890 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7895 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7896 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7901 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7902 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7908 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7913 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7917 cd write (2,*) iii,g_corr5_loc(iii)
7921 cd write (2,*) 'ekont',ekont
7922 cd write (iout,*) 'eello5',ekont*eel5
7925 c--------------------------------------------------------------------------
7926 double precision function eello6(i,j,k,l,jj,kk)
7927 implicit real*8 (a-h,o-z)
7928 include 'DIMENSIONS'
7929 include 'DIMENSIONS.ZSCOPT'
7930 include 'COMMON.IOUNITS'
7931 include 'COMMON.CHAIN'
7932 include 'COMMON.DERIV'
7933 include 'COMMON.INTERACT'
7934 include 'COMMON.CONTACTS'
7935 include 'COMMON.TORSION'
7936 include 'COMMON.VAR'
7937 include 'COMMON.GEO'
7938 include 'COMMON.FFIELD'
7939 double precision ggg1(3),ggg2(3)
7940 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7945 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7953 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7954 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7958 derx(lll,kkk,iii)=0.0d0
7962 cd eij=facont_hb(jj,i)
7963 cd ekl=facont_hb(kk,k)
7969 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7970 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7971 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7972 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7973 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7974 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7976 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7977 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7978 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7979 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7980 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7981 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7985 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7987 C If turn contributions are considered, they will be handled separately.
7988 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7989 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7990 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7991 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7992 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7993 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7994 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7997 if (j.lt.nres-1) then
8004 if (l.lt.nres-1) then
8012 ggg1(ll)=eel6*g_contij(ll,1)
8013 ggg2(ll)=eel6*g_contij(ll,2)
8014 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8015 ghalf=0.5d0*ggg1(ll)
8017 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
8018 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8019 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
8020 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8021 ghalf=0.5d0*ggg2(ll)
8022 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8024 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
8025 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8026 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
8027 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8032 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8033 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8038 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8039 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8045 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8050 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8054 cd write (2,*) iii,g_corr6_loc(iii)
8058 cd write (2,*) 'ekont',ekont
8059 cd write (iout,*) 'eello6',ekont*eel6
8062 c--------------------------------------------------------------------------
8063 double precision function eello6_graph1(i,j,k,l,imat,swap)
8064 implicit real*8 (a-h,o-z)
8065 include 'DIMENSIONS'
8066 include 'DIMENSIONS.ZSCOPT'
8067 include 'COMMON.IOUNITS'
8068 include 'COMMON.CHAIN'
8069 include 'COMMON.DERIV'
8070 include 'COMMON.INTERACT'
8071 include 'COMMON.CONTACTS'
8072 include 'COMMON.TORSION'
8073 include 'COMMON.VAR'
8074 include 'COMMON.GEO'
8075 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8079 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8081 C Parallel Antiparallel C
8087 C \ j|/k\| / \ |/k\|l / C
8092 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8093 itk=itortyp(itype(k))
8094 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8095 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8096 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8097 call transpose2(EUgC(1,1,k),auxmat(1,1))
8098 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8099 vv1(1)=pizda1(1,1)-pizda1(2,2)
8100 vv1(2)=pizda1(1,2)+pizda1(2,1)
8101 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8102 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8103 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8104 s5=scalar2(vv(1),Dtobr2(1,i))
8105 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8106 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8107 if (.not. calc_grad) return
8108 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8109 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8110 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8111 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8112 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8113 & +scalar2(vv(1),Dtobr2der(1,i)))
8114 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8115 vv1(1)=pizda1(1,1)-pizda1(2,2)
8116 vv1(2)=pizda1(1,2)+pizda1(2,1)
8117 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8118 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8120 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8121 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8122 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8123 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8124 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8126 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8127 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8128 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8129 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8130 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8132 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8133 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8134 vv1(1)=pizda1(1,1)-pizda1(2,2)
8135 vv1(2)=pizda1(1,2)+pizda1(2,1)
8136 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8137 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8138 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8139 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8148 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8149 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8150 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8151 call transpose2(EUgC(1,1,k),auxmat(1,1))
8152 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8154 vv1(1)=pizda1(1,1)-pizda1(2,2)
8155 vv1(2)=pizda1(1,2)+pizda1(2,1)
8156 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8157 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8158 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8159 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8160 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8161 s5=scalar2(vv(1),Dtobr2(1,i))
8162 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8168 c----------------------------------------------------------------------------
8169 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8170 implicit real*8 (a-h,o-z)
8171 include 'DIMENSIONS'
8172 include 'DIMENSIONS.ZSCOPT'
8173 include 'COMMON.IOUNITS'
8174 include 'COMMON.CHAIN'
8175 include 'COMMON.DERIV'
8176 include 'COMMON.INTERACT'
8177 include 'COMMON.CONTACTS'
8178 include 'COMMON.TORSION'
8179 include 'COMMON.VAR'
8180 include 'COMMON.GEO'
8182 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8183 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8186 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8188 C Parallel Antiparallel C
8194 C \ j|/k\| \ |/k\|l C
8199 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8200 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8201 C AL 7/4/01 s1 would occur in the sixth-order moment,
8202 C but not in a cluster cumulant
8204 s1=dip(1,jj,i)*dip(1,kk,k)
8206 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8207 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8208 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8209 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8210 call transpose2(EUg(1,1,k),auxmat(1,1))
8211 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8212 vv(1)=pizda(1,1)-pizda(2,2)
8213 vv(2)=pizda(1,2)+pizda(2,1)
8214 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8215 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8217 eello6_graph2=-(s1+s2+s3+s4)
8219 eello6_graph2=-(s2+s3+s4)
8222 if (.not. calc_grad) return
8223 C Derivatives in gamma(i-1)
8226 s1=dipderg(1,jj,i)*dip(1,kk,k)
8228 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8229 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8230 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8231 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8233 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8235 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8237 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8239 C Derivatives in gamma(k-1)
8241 s1=dip(1,jj,i)*dipderg(1,kk,k)
8243 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8244 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8245 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8246 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8247 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8248 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8249 vv(1)=pizda(1,1)-pizda(2,2)
8250 vv(2)=pizda(1,2)+pizda(2,1)
8251 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8253 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8255 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8257 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8258 C Derivatives in gamma(j-1) or gamma(l-1)
8261 s1=dipderg(3,jj,i)*dip(1,kk,k)
8263 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8264 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8265 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8266 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8267 vv(1)=pizda(1,1)-pizda(2,2)
8268 vv(2)=pizda(1,2)+pizda(2,1)
8269 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8272 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8274 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8277 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8278 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8280 C Derivatives in gamma(l-1) or gamma(j-1)
8283 s1=dip(1,jj,i)*dipderg(3,kk,k)
8285 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8286 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8287 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8288 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8289 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8290 vv(1)=pizda(1,1)-pizda(2,2)
8291 vv(2)=pizda(1,2)+pizda(2,1)
8292 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8295 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8297 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8300 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8301 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8303 C Cartesian derivatives.
8305 write (2,*) 'In eello6_graph2'
8307 write (2,*) 'iii=',iii
8309 write (2,*) 'kkk=',kkk
8311 write (2,'(3(2f10.5),5x)')
8312 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8322 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8324 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8327 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8329 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8330 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8332 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8333 call transpose2(EUg(1,1,k),auxmat(1,1))
8334 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8336 vv(1)=pizda(1,1)-pizda(2,2)
8337 vv(2)=pizda(1,2)+pizda(2,1)
8338 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8339 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8341 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8343 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8346 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8348 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8355 c----------------------------------------------------------------------------
8356 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8357 implicit real*8 (a-h,o-z)
8358 include 'DIMENSIONS'
8359 include 'DIMENSIONS.ZSCOPT'
8360 include 'COMMON.IOUNITS'
8361 include 'COMMON.CHAIN'
8362 include 'COMMON.DERIV'
8363 include 'COMMON.INTERACT'
8364 include 'COMMON.CONTACTS'
8365 include 'COMMON.TORSION'
8366 include 'COMMON.VAR'
8367 include 'COMMON.GEO'
8368 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8370 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8372 C Parallel Antiparallel C
8378 C j|/k\| / |/k\|l / C
8383 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8385 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8386 C energy moment and not to the cluster cumulant.
8387 iti=itortyp(itype(i))
8388 if (j.lt.nres-1) then
8389 itj1=itortyp(itype(j+1))
8393 itk=itortyp(itype(k))
8394 itk1=itortyp(itype(k+1))
8395 if (l.lt.nres-1) then
8396 itl1=itortyp(itype(l+1))
8401 s1=dip(4,jj,i)*dip(4,kk,k)
8403 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8404 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8405 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8406 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8407 call transpose2(EE(1,1,itk),auxmat(1,1))
8408 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8409 vv(1)=pizda(1,1)+pizda(2,2)
8410 vv(2)=pizda(2,1)-pizda(1,2)
8411 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8412 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8414 eello6_graph3=-(s1+s2+s3+s4)
8416 eello6_graph3=-(s2+s3+s4)
8419 if (.not. calc_grad) return
8420 C Derivatives in gamma(k-1)
8421 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8422 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8423 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8424 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8425 C Derivatives in gamma(l-1)
8426 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8427 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8428 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8429 vv(1)=pizda(1,1)+pizda(2,2)
8430 vv(2)=pizda(2,1)-pizda(1,2)
8431 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8432 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8433 C Cartesian derivatives.
8439 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8441 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8444 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8446 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8447 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8449 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8450 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8452 vv(1)=pizda(1,1)+pizda(2,2)
8453 vv(2)=pizda(2,1)-pizda(1,2)
8454 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8456 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8458 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8461 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8463 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8465 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8471 c----------------------------------------------------------------------------
8472 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8473 implicit real*8 (a-h,o-z)
8474 include 'DIMENSIONS'
8475 include 'DIMENSIONS.ZSCOPT'
8476 include 'COMMON.IOUNITS'
8477 include 'COMMON.CHAIN'
8478 include 'COMMON.DERIV'
8479 include 'COMMON.INTERACT'
8480 include 'COMMON.CONTACTS'
8481 include 'COMMON.TORSION'
8482 include 'COMMON.VAR'
8483 include 'COMMON.GEO'
8484 include 'COMMON.FFIELD'
8485 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8486 & auxvec1(2),auxmat1(2,2)
8488 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8490 C Parallel Antiparallel C
8496 C \ j|/k\| \ |/k\|l C
8501 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8503 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8504 C energy moment and not to the cluster cumulant.
8505 cd write (2,*) 'eello_graph4: wturn6',wturn6
8506 iti=itortyp(itype(i))
8507 itj=itortyp(itype(j))
8508 if (j.lt.nres-1) then
8509 itj1=itortyp(itype(j+1))
8513 itk=itortyp(itype(k))
8514 if (k.lt.nres-1) then
8515 itk1=itortyp(itype(k+1))
8519 itl=itortyp(itype(l))
8520 if (l.lt.nres-1) then
8521 itl1=itortyp(itype(l+1))
8525 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8526 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8527 cd & ' itl',itl,' itl1',itl1
8530 s1=dip(3,jj,i)*dip(3,kk,k)
8532 s1=dip(2,jj,j)*dip(2,kk,l)
8535 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8536 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8538 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8539 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8541 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8542 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8544 call transpose2(EUg(1,1,k),auxmat(1,1))
8545 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8546 vv(1)=pizda(1,1)-pizda(2,2)
8547 vv(2)=pizda(2,1)+pizda(1,2)
8548 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8549 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8551 eello6_graph4=-(s1+s2+s3+s4)
8553 eello6_graph4=-(s2+s3+s4)
8555 if (.not. calc_grad) return
8556 C Derivatives in gamma(i-1)
8560 s1=dipderg(2,jj,i)*dip(3,kk,k)
8562 s1=dipderg(4,jj,j)*dip(2,kk,l)
8565 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8567 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8568 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8570 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8571 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8573 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8574 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8575 cd write (2,*) 'turn6 derivatives'
8577 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8579 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8583 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8585 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8589 C Derivatives in gamma(k-1)
8592 s1=dip(3,jj,i)*dipderg(2,kk,k)
8594 s1=dip(2,jj,j)*dipderg(4,kk,l)
8597 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8598 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8600 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8601 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8603 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8604 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8606 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8607 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8608 vv(1)=pizda(1,1)-pizda(2,2)
8609 vv(2)=pizda(2,1)+pizda(1,2)
8610 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8611 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8613 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8615 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8619 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8621 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8624 C Derivatives in gamma(j-1) or gamma(l-1)
8625 if (l.eq.j+1 .and. l.gt.1) then
8626 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8627 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8628 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8629 vv(1)=pizda(1,1)-pizda(2,2)
8630 vv(2)=pizda(2,1)+pizda(1,2)
8631 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8632 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8633 else if (j.gt.1) then
8634 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8635 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8636 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8637 vv(1)=pizda(1,1)-pizda(2,2)
8638 vv(2)=pizda(2,1)+pizda(1,2)
8639 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8640 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8641 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8643 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8646 C Cartesian derivatives.
8653 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8655 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8659 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8661 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8665 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8667 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8669 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8670 & b1(1,itj1),auxvec(1))
8671 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8673 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8674 & b1(1,itl1),auxvec(1))
8675 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8677 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8679 vv(1)=pizda(1,1)-pizda(2,2)
8680 vv(2)=pizda(2,1)+pizda(1,2)
8681 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8683 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8685 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8688 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8691 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8694 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8696 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8698 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8702 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8704 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8707 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8709 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8717 c----------------------------------------------------------------------------
8718 double precision function eello_turn6(i,jj,kk)
8719 implicit real*8 (a-h,o-z)
8720 include 'DIMENSIONS'
8721 include 'DIMENSIONS.ZSCOPT'
8722 include 'COMMON.IOUNITS'
8723 include 'COMMON.CHAIN'
8724 include 'COMMON.DERIV'
8725 include 'COMMON.INTERACT'
8726 include 'COMMON.CONTACTS'
8727 include 'COMMON.TORSION'
8728 include 'COMMON.VAR'
8729 include 'COMMON.GEO'
8730 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8731 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8733 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8734 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8735 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8736 C the respective energy moment and not to the cluster cumulant.
8741 iti=itortyp(itype(i))
8742 itk=itortyp(itype(k))
8743 itk1=itortyp(itype(k+1))
8744 itl=itortyp(itype(l))
8745 itj=itortyp(itype(j))
8746 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8747 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8748 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8753 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8755 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8759 derx_turn(lll,kkk,iii)=0.0d0
8766 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8768 cd write (2,*) 'eello6_5',eello6_5
8770 call transpose2(AEA(1,1,1),auxmat(1,1))
8771 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8772 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8773 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8777 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8778 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8779 s2 = scalar2(b1(1,itk),vtemp1(1))
8781 call transpose2(AEA(1,1,2),atemp(1,1))
8782 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8783 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8784 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8788 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8789 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8790 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8792 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8793 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8794 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8795 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8796 ss13 = scalar2(b1(1,itk),vtemp4(1))
8797 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8801 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8807 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8809 C Derivatives in gamma(i+2)
8811 call transpose2(AEA(1,1,1),auxmatd(1,1))
8812 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8813 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8814 call transpose2(AEAderg(1,1,2),atempd(1,1))
8815 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8816 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8820 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8821 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8822 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8828 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8829 C Derivatives in gamma(i+3)
8831 call transpose2(AEA(1,1,1),auxmatd(1,1))
8832 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8833 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8834 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8838 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8839 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8840 s2d = scalar2(b1(1,itk),vtemp1d(1))
8842 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8843 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8845 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8847 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8848 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8849 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8859 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8860 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8862 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8863 & -0.5d0*ekont*(s2d+s12d)
8865 C Derivatives in gamma(i+4)
8866 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8867 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8868 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8870 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8871 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8872 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8882 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8884 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8886 C Derivatives in gamma(i+5)
8888 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8889 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8890 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8894 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8895 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8896 s2d = scalar2(b1(1,itk),vtemp1d(1))
8898 call transpose2(AEA(1,1,2),atempd(1,1))
8899 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8900 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8904 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8905 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8907 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8908 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8909 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8919 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8920 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8922 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8923 & -0.5d0*ekont*(s2d+s12d)
8925 C Cartesian derivatives
8930 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8931 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8932 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8936 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8937 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8939 s2d = scalar2(b1(1,itk),vtemp1d(1))
8941 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8942 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8943 s8d = -(atempd(1,1)+atempd(2,2))*
8944 & scalar2(cc(1,1,itl),vtemp2(1))
8948 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8950 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8951 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8958 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8961 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8965 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8966 & - 0.5d0*(s8d+s12d)
8968 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8977 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8979 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8980 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8981 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8982 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8983 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8985 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8986 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8987 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8991 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8992 cd & 16*eel_turn6_num
8994 if (j.lt.nres-1) then
9001 if (l.lt.nres-1) then
9009 ggg1(ll)=eel_turn6*g_contij(ll,1)
9010 ggg2(ll)=eel_turn6*g_contij(ll,2)
9011 ghalf=0.5d0*ggg1(ll)
9013 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
9014 & +ekont*derx_turn(ll,2,1)
9015 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9016 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
9017 & +ekont*derx_turn(ll,4,1)
9018 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9019 ghalf=0.5d0*ggg2(ll)
9021 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
9022 & +ekont*derx_turn(ll,2,2)
9023 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9024 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
9025 & +ekont*derx_turn(ll,4,2)
9026 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9031 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9036 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9042 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9047 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9051 cd write (2,*) iii,g_corr6_loc(iii)
9054 eello_turn6=ekont*eel_turn6
9055 cd write (2,*) 'ekont',ekont
9056 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9059 crc-------------------------------------------------
9060 SUBROUTINE MATVEC2(A1,V1,V2)
9061 implicit real*8 (a-h,o-z)
9062 include 'DIMENSIONS'
9063 DIMENSION A1(2,2),V1(2),V2(2)
9067 c 3 VI=VI+A1(I,K)*V1(K)
9071 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9072 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9077 C---------------------------------------
9078 SUBROUTINE MATMAT2(A1,A2,A3)
9079 implicit real*8 (a-h,o-z)
9080 include 'DIMENSIONS'
9081 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9082 c DIMENSION AI3(2,2)
9086 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9092 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9093 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9094 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9095 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9103 c-------------------------------------------------------------------------
9104 double precision function scalar2(u,v)
9106 double precision u(2),v(2)
9109 scalar2=u(1)*v(1)+u(2)*v(2)
9113 C-----------------------------------------------------------------------------
9115 subroutine transpose2(a,at)
9117 double precision a(2,2),at(2,2)
9124 c--------------------------------------------------------------------------
9125 subroutine transpose(n,a,at)
9128 double precision a(n,n),at(n,n)
9136 C---------------------------------------------------------------------------
9137 subroutine prodmat3(a1,a2,kk,transp,prod)
9140 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9142 crc double precision auxmat(2,2),prod_(2,2)
9145 crc call transpose2(kk(1,1),auxmat(1,1))
9146 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9147 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9149 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9150 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9151 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9152 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9153 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9154 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9155 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9156 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9159 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9160 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9162 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9163 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9164 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9165 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9166 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9167 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9168 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9169 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9172 c call transpose2(a2(1,1),a2t(1,1))
9175 crc print *,((prod_(i,j),i=1,2),j=1,2)
9176 crc print *,((prod(i,j),i=1,2),j=1,2)
9180 C-----------------------------------------------------------------------------
9181 double precision function scalar(u,v)
9183 double precision u(3),v(3)