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.
3305 if (i.gt. nnt+2 .and. i.lt.nct+2) then
3306 iti = itortyp(itype(i-2))
3310 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3311 iti1 = itortyp(itype(i-1))
3315 b1(1,i-2)=bnew1(1,1,iti)*sin(theta(i-1)/2.0)
3316 & +bnew1(2,1,iti)*sin(theta(i-1))
3317 & +bnew1(3,1,iti)*cos(theta(i-1)/2.0)
3318 b2(1,i-2)=bnew2(1,1,iti)*sin(theta(i-1)/2.0)
3319 & +bnew2(2,1,iti)*sin(theta(i-1))
3320 & +bnew2(3,1,iti)*cos(theta(i-1)/2.0)
3321 b1(2,i-2)=bnew1(1,2,iti)
3322 b2(2,i-2)=bnew2(1,2,iti)
3323 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
3324 EE(1,2,i-2)=eeold(1,2,iti)
3325 EE(2,1,i-2)=eeold(2,1,iti)
3326 EE(2,2,i-2)=eeold(2,2,iti)
3327 b1tilde(1,i-2)=b1(1,i-2)
3328 b1tilde(2,i-2)=-b1(2,i-2)
3332 if (i .lt. nres+1) then
3369 if (i .gt. 3 .and. i .lt. nres+1) then
3370 obrot_der(1,i-2)=-sin1
3371 obrot_der(2,i-2)= cos1
3372 Ugder(1,1,i-2)= sin1
3373 Ugder(1,2,i-2)=-cos1
3374 Ugder(2,1,i-2)=-cos1
3375 Ugder(2,2,i-2)=-sin1
3378 obrot2_der(1,i-2)=-dwasin2
3379 obrot2_der(2,i-2)= dwacos2
3380 Ug2der(1,1,i-2)= dwasin2
3381 Ug2der(1,2,i-2)=-dwacos2
3382 Ug2der(2,1,i-2)=-dwacos2
3383 Ug2der(2,2,i-2)=-dwasin2
3385 obrot_der(1,i-2)=0.0d0
3386 obrot_der(2,i-2)=0.0d0
3387 Ugder(1,1,i-2)=0.0d0
3388 Ugder(1,2,i-2)=0.0d0
3389 Ugder(2,1,i-2)=0.0d0
3390 Ugder(2,2,i-2)=0.0d0
3391 obrot2_der(1,i-2)=0.0d0
3392 obrot2_der(2,i-2)=0.0d0
3393 Ug2der(1,1,i-2)=0.0d0
3394 Ug2der(1,2,i-2)=0.0d0
3395 Ug2der(2,1,i-2)=0.0d0
3396 Ug2der(2,2,i-2)=0.0d0
3398 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
3399 iti = itortyp(itype(i-2))
3403 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3404 iti1 = itortyp(itype(i-1))
3408 cd write (iout,*) '*******i',i,' iti1',iti
3409 cd write (iout,*) 'b1',b1(:,iti)
3410 cd write (iout,*) 'b2',b2(:,iti)
3411 cd write (iout,*) 'Ug',Ug(:,:,i-2)
3412 if (i .gt. iatel_s+2) then
3413 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
3414 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
3415 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
3416 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
3417 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3418 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
3419 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
3429 DtUg2(l,k,i-2)=0.0d0
3433 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
3434 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
3435 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3436 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3437 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3438 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3439 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3441 muder(k,i-2)=Ub2der(k,i-2)
3443 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3444 iti1 = itortyp(itype(i-1))
3449 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
3451 C Vectors and matrices dependent on a single virtual-bond dihedral.
3452 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
3453 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3454 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3455 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3456 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3457 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3458 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3459 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3460 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3461 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
3462 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
3464 C Matrices dependent on two consecutive virtual-bond dihedrals.
3465 C The order of matrices is from left to right.
3467 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3468 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3469 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3470 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3471 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3472 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3473 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3474 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3477 cd iti = itortyp(itype(i))
3480 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3481 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3486 C--------------------------------------------------------------------------
3487 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3489 C This subroutine calculates the average interaction energy and its gradient
3490 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3491 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3492 C The potential depends both on the distance of peptide-group centers and on
3493 C the orientation of the CA-CA virtual bonds.
3495 implicit real*8 (a-h,o-z)
3496 include 'DIMENSIONS'
3497 include 'DIMENSIONS.ZSCOPT'
3498 include 'COMMON.CONTROL'
3499 include 'COMMON.IOUNITS'
3500 include 'COMMON.GEO'
3501 include 'COMMON.VAR'
3502 include 'COMMON.LOCAL'
3503 include 'COMMON.CHAIN'
3504 include 'COMMON.DERIV'
3505 include 'COMMON.INTERACT'
3506 include 'COMMON.CONTACTS'
3507 include 'COMMON.TORSION'
3508 include 'COMMON.VECTORS'
3509 include 'COMMON.FFIELD'
3510 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3511 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3512 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3513 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3514 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
3515 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3516 double precision scal_el /0.5d0/
3518 C 13-go grudnia roku pamietnego...
3519 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3520 & 0.0d0,1.0d0,0.0d0,
3521 & 0.0d0,0.0d0,1.0d0/
3522 cd write(iout,*) 'In EELEC'
3524 cd write(iout,*) 'Type',i
3525 cd write(iout,*) 'B1',B1(:,i)
3526 cd write(iout,*) 'B2',B2(:,i)
3527 cd write(iout,*) 'CC',CC(:,:,i)
3528 cd write(iout,*) 'DD',DD(:,:,i)
3529 cd write(iout,*) 'EE',EE(:,:,i)
3531 cd call check_vecgrad
3533 if (icheckgrad.eq.1) then
3535 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3537 dc_norm(k,i)=dc(k,i)*fac
3539 c write (iout,*) 'i',i,' fac',fac
3542 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3543 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3544 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3545 cd if (wel_loc.gt.0.0d0) then
3546 if (icheckgrad.eq.1) then
3547 call vec_and_deriv_test
3554 cd write (iout,*) 'i=',i
3556 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3559 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3560 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3573 cd print '(a)','Enter EELEC'
3574 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3576 gel_loc_loc(i)=0.0d0
3579 do i=iatel_s,iatel_e
3580 if (itel(i).eq.0) goto 1215
3584 dx_normi=dc_norm(1,i)
3585 dy_normi=dc_norm(2,i)
3586 dz_normi=dc_norm(3,i)
3587 xmedi=c(1,i)+0.5d0*dxi
3588 ymedi=c(2,i)+0.5d0*dyi
3589 zmedi=c(3,i)+0.5d0*dzi
3591 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3592 do j=ielstart(i),ielend(i)
3593 if (itel(j).eq.0) goto 1216
3597 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3598 aaa=app(iteli,itelj)
3599 bbb=bpp(iteli,itelj)
3600 C Diagnostics only!!!
3606 ael6i=ael6(iteli,itelj)
3607 ael3i=ael3(iteli,itelj)
3611 dx_normj=dc_norm(1,j)
3612 dy_normj=dc_norm(2,j)
3613 dz_normj=dc_norm(3,j)
3614 xj=c(1,j)+0.5D0*dxj-xmedi
3615 yj=c(2,j)+0.5D0*dyj-ymedi
3616 zj=c(3,j)+0.5D0*dzj-zmedi
3617 rij=xj*xj+yj*yj+zj*zj
3623 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3624 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3625 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3626 fac=cosa-3.0D0*cosb*cosg
3628 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3629 if (j.eq.i+2) ev1=scal_el*ev1
3634 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3637 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
3638 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3639 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3642 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3643 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3644 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3645 cd & xmedi,ymedi,zmedi,xj,yj,zj
3647 C Calculate contributions to the Cartesian gradient.
3650 facvdw=-6*rrmij*(ev1+evdwij)
3651 facel=-3*rrmij*(el1+eesij)
3658 * Radial derivatives. First process both termini of the fragment (i,j)
3665 gelc(k,i)=gelc(k,i)+ghalf
3666 gelc(k,j)=gelc(k,j)+ghalf
3669 * Loop over residues i+1 thru j-1.
3673 gelc(l,k)=gelc(l,k)+ggg(l)
3681 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3682 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3685 * Loop over residues i+1 thru j-1.
3689 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3696 fac=-3*rrmij*(facvdw+facvdw+facel)
3702 * Radial derivatives. First process both termini of the fragment (i,j)
3709 gelc(k,i)=gelc(k,i)+ghalf
3710 gelc(k,j)=gelc(k,j)+ghalf
3713 * Loop over residues i+1 thru j-1.
3717 gelc(l,k)=gelc(l,k)+ggg(l)
3724 ecosa=2.0D0*fac3*fac1+fac4
3727 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3728 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3730 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3731 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3733 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3734 cd & (dcosg(k),k=1,3)
3736 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3740 gelc(k,i)=gelc(k,i)+ghalf
3741 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3742 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3743 gelc(k,j)=gelc(k,j)+ghalf
3744 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3745 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3749 gelc(l,k)=gelc(l,k)+ggg(l)
3754 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3755 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3756 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3758 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3759 C energy of a peptide unit is assumed in the form of a second-order
3760 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3761 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3762 C are computed for EVERY pair of non-contiguous peptide groups.
3764 if (j.lt.nres-1) then
3775 muij(kkk)=mu(k,i)*mu(l,j)
3778 cd write (iout,*) 'EELEC: i',i,' j',j
3779 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3780 cd write(iout,*) 'muij',muij
3781 ury=scalar(uy(1,i),erij)
3782 urz=scalar(uz(1,i),erij)
3783 vry=scalar(uy(1,j),erij)
3784 vrz=scalar(uz(1,j),erij)
3785 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3786 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3787 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3788 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3789 C For diagnostics only
3794 fac=dsqrt(-ael6i)*r3ij
3795 cd write (2,*) 'fac=',fac
3796 C For diagnostics only
3802 cd write (iout,'(4i5,4f10.5)')
3803 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3804 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3805 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
3806 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
3807 cd write (iout,'(4f10.5)')
3808 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3809 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3810 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3811 cd write (iout,'(2i3,9f10.5/)') i,j,
3812 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3814 C Derivatives of the elements of A in virtual-bond vectors
3815 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3822 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3823 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3824 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3825 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3826 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3827 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3828 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3829 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3830 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3831 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3832 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3833 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3843 C Compute radial contributions to the gradient
3865 C Add the contributions coming from er
3868 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3869 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3870 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3871 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3874 C Derivatives in DC(i)
3875 ghalf1=0.5d0*agg(k,1)
3876 ghalf2=0.5d0*agg(k,2)
3877 ghalf3=0.5d0*agg(k,3)
3878 ghalf4=0.5d0*agg(k,4)
3879 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3880 & -3.0d0*uryg(k,2)*vry)+ghalf1
3881 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3882 & -3.0d0*uryg(k,2)*vrz)+ghalf2
3883 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3884 & -3.0d0*urzg(k,2)*vry)+ghalf3
3885 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3886 & -3.0d0*urzg(k,2)*vrz)+ghalf4
3887 C Derivatives in DC(i+1)
3888 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3889 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
3890 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3891 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
3892 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3893 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
3894 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3895 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
3896 C Derivatives in DC(j)
3897 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3898 & -3.0d0*vryg(k,2)*ury)+ghalf1
3899 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3900 & -3.0d0*vrzg(k,2)*ury)+ghalf2
3901 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3902 & -3.0d0*vryg(k,2)*urz)+ghalf3
3903 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3904 & -3.0d0*vrzg(k,2)*urz)+ghalf4
3905 C Derivatives in DC(j+1) or DC(nres-1)
3906 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3907 & -3.0d0*vryg(k,3)*ury)
3908 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3909 & -3.0d0*vrzg(k,3)*ury)
3910 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3911 & -3.0d0*vryg(k,3)*urz)
3912 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3913 & -3.0d0*vrzg(k,3)*urz)
3918 C Derivatives in DC(i+1)
3919 cd aggi1(k,1)=agg(k,1)
3920 cd aggi1(k,2)=agg(k,2)
3921 cd aggi1(k,3)=agg(k,3)
3922 cd aggi1(k,4)=agg(k,4)
3923 C Derivatives in DC(j)
3928 C Derivatives in DC(j+1)
3933 if (j.eq.nres-1 .and. i.lt.j-2) then
3935 aggj1(k,l)=aggj1(k,l)+agg(k,l)
3936 cd aggj1(k,l)=agg(k,l)
3942 C Check the loc-el terms by numerical integration
3952 aggi(k,l)=-aggi(k,l)
3953 aggi1(k,l)=-aggi1(k,l)
3954 aggj(k,l)=-aggj(k,l)
3955 aggj1(k,l)=-aggj1(k,l)
3958 if (j.lt.nres-1) then
3964 aggi(k,l)=-aggi(k,l)
3965 aggi1(k,l)=-aggi1(k,l)
3966 aggj(k,l)=-aggj(k,l)
3967 aggj1(k,l)=-aggj1(k,l)
3978 aggi(k,l)=-aggi(k,l)
3979 aggi1(k,l)=-aggi1(k,l)
3980 aggj(k,l)=-aggj(k,l)
3981 aggj1(k,l)=-aggj1(k,l)
3987 IF (wel_loc.gt.0.0d0) THEN
3988 C Contribution to the local-electrostatic energy coming from the i-j pair
3989 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3991 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3992 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3993 eel_loc=eel_loc+eel_loc_ij
3994 C Partial derivatives in virtual-bond dihedral angles gamma
3997 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3998 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3999 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4000 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4001 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4002 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4003 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
4004 cd write(iout,*) 'agg ',agg
4005 cd write(iout,*) 'aggi ',aggi
4006 cd write(iout,*) 'aggi1',aggi1
4007 cd write(iout,*) 'aggj ',aggj
4008 cd write(iout,*) 'aggj1',aggj1
4010 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4012 ggg(l)=agg(l,1)*muij(1)+
4013 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4017 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4020 C Remaining derivatives of eello
4022 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
4023 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
4024 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
4025 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
4026 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
4027 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
4028 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
4029 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
4033 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4034 C Contributions from turns
4039 call eturn34(i,j,eello_turn3,eello_turn4)
4041 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4042 if (j.gt.i+1 .and. num_conti.le.maxconts) then
4044 C Calculate the contact function. The ith column of the array JCONT will
4045 C contain the numbers of atoms that make contacts with the atom I (of numbers
4046 C greater than I). The arrays FACONT and GACONT will contain the values of
4047 C the contact function and its derivative.
4048 c r0ij=1.02D0*rpp(iteli,itelj)
4049 c r0ij=1.11D0*rpp(iteli,itelj)
4050 r0ij=2.20D0*rpp(iteli,itelj)
4051 c r0ij=1.55D0*rpp(iteli,itelj)
4052 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4053 if (fcont.gt.0.0D0) then
4054 num_conti=num_conti+1
4055 if (num_conti.gt.maxconts) then
4056 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4057 & ' will skip next contacts for this conf.'
4059 jcont_hb(num_conti,i)=j
4060 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4061 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4062 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4064 d_cont(num_conti,i)=rij
4065 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4066 C --- Electrostatic-interaction matrix ---
4067 a_chuj(1,1,num_conti,i)=a22
4068 a_chuj(1,2,num_conti,i)=a23
4069 a_chuj(2,1,num_conti,i)=a32
4070 a_chuj(2,2,num_conti,i)=a33
4071 C --- Gradient of rij
4073 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4076 c a_chuj(1,1,num_conti,i)=-0.61d0
4077 c a_chuj(1,2,num_conti,i)= 0.4d0
4078 c a_chuj(2,1,num_conti,i)= 0.65d0
4079 c a_chuj(2,2,num_conti,i)= 0.50d0
4080 c else if (i.eq.2) then
4081 c a_chuj(1,1,num_conti,i)= 0.0d0
4082 c a_chuj(1,2,num_conti,i)= 0.0d0
4083 c a_chuj(2,1,num_conti,i)= 0.0d0
4084 c a_chuj(2,2,num_conti,i)= 0.0d0
4086 C --- and its gradients
4087 cd write (iout,*) 'i',i,' j',j
4089 cd write (iout,*) 'iii 1 kkk',kkk
4090 cd write (iout,*) agg(kkk,:)
4093 cd write (iout,*) 'iii 2 kkk',kkk
4094 cd write (iout,*) aggi(kkk,:)
4097 cd write (iout,*) 'iii 3 kkk',kkk
4098 cd write (iout,*) aggi1(kkk,:)
4101 cd write (iout,*) 'iii 4 kkk',kkk
4102 cd write (iout,*) aggj(kkk,:)
4105 cd write (iout,*) 'iii 5 kkk',kkk
4106 cd write (iout,*) aggj1(kkk,:)
4113 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4114 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4115 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4116 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4117 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4119 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
4125 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4126 C Calculate contact energies
4128 wij=cosa-3.0D0*cosb*cosg
4131 c fac3=dsqrt(-ael6i)/r0ij**3
4132 fac3=dsqrt(-ael6i)*r3ij
4133 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4134 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4136 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4137 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4138 C Diagnostics. Comment out or remove after debugging!
4139 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4140 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4141 c ees0m(num_conti,i)=0.0D0
4143 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4144 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4145 facont_hb(num_conti,i)=fcont
4147 C Angular derivatives of the contact function
4148 ees0pij1=fac3/ees0pij
4149 ees0mij1=fac3/ees0mij
4150 fac3p=-3.0D0*fac3*rrmij
4151 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4152 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4154 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4155 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4156 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4157 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4158 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4159 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4160 ecosap=ecosa1+ecosa2
4161 ecosbp=ecosb1+ecosb2
4162 ecosgp=ecosg1+ecosg2
4163 ecosam=ecosa1-ecosa2
4164 ecosbm=ecosb1-ecosb2
4165 ecosgm=ecosg1-ecosg2
4174 fprimcont=fprimcont/rij
4175 cd facont_hb(num_conti,i)=1.0D0
4176 C Following line is for diagnostics.
4179 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4180 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4183 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4184 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4186 gggp(1)=gggp(1)+ees0pijp*xj
4187 gggp(2)=gggp(2)+ees0pijp*yj
4188 gggp(3)=gggp(3)+ees0pijp*zj
4189 gggm(1)=gggm(1)+ees0mijp*xj
4190 gggm(2)=gggm(2)+ees0mijp*yj
4191 gggm(3)=gggm(3)+ees0mijp*zj
4192 C Derivatives due to the contact function
4193 gacont_hbr(1,num_conti,i)=fprimcont*xj
4194 gacont_hbr(2,num_conti,i)=fprimcont*yj
4195 gacont_hbr(3,num_conti,i)=fprimcont*zj
4197 ghalfp=0.5D0*gggp(k)
4198 ghalfm=0.5D0*gggm(k)
4199 gacontp_hb1(k,num_conti,i)=ghalfp
4200 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4201 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4202 gacontp_hb2(k,num_conti,i)=ghalfp
4203 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4204 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4205 gacontp_hb3(k,num_conti,i)=gggp(k)
4206 gacontm_hb1(k,num_conti,i)=ghalfm
4207 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4208 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4209 gacontm_hb2(k,num_conti,i)=ghalfm
4210 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4211 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4212 gacontm_hb3(k,num_conti,i)=gggm(k)
4215 C Diagnostics. Comment out or remove after debugging!
4217 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4218 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4219 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4220 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4221 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4222 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4225 endif ! num_conti.le.maxconts
4230 num_cont_hb(i)=num_conti
4234 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
4235 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
4237 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
4238 ccc eel_loc=eel_loc+eello_turn3
4241 C-----------------------------------------------------------------------------
4242 subroutine eturn34(i,j,eello_turn3,eello_turn4)
4243 C Third- and fourth-order contributions from turns
4244 implicit real*8 (a-h,o-z)
4245 include 'DIMENSIONS'
4246 include 'DIMENSIONS.ZSCOPT'
4247 include 'COMMON.IOUNITS'
4248 include 'COMMON.GEO'
4249 include 'COMMON.VAR'
4250 include 'COMMON.LOCAL'
4251 include 'COMMON.CHAIN'
4252 include 'COMMON.DERIV'
4253 include 'COMMON.INTERACT'
4254 include 'COMMON.CONTACTS'
4255 include 'COMMON.TORSION'
4256 include 'COMMON.VECTORS'
4257 include 'COMMON.FFIELD'
4259 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4260 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4261 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
4262 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4263 & aggj(3,4),aggj1(3,4),a_temp(2,2)
4264 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
4266 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4268 C Third-order contributions
4275 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4276 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4277 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4278 call transpose2(auxmat(1,1),auxmat1(1,1))
4279 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4280 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4281 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4282 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4283 cd & ' eello_turn3_num',4*eello_turn3_num
4285 C Derivatives in gamma(i)
4286 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4287 call transpose2(auxmat2(1,1),pizda(1,1))
4288 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4289 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4290 C Derivatives in gamma(i+1)
4291 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4292 call transpose2(auxmat2(1,1),pizda(1,1))
4293 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4294 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4295 & +0.5d0*(pizda(1,1)+pizda(2,2))
4296 C Cartesian derivatives
4298 a_temp(1,1)=aggi(l,1)
4299 a_temp(1,2)=aggi(l,2)
4300 a_temp(2,1)=aggi(l,3)
4301 a_temp(2,2)=aggi(l,4)
4302 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4303 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4304 & +0.5d0*(pizda(1,1)+pizda(2,2))
4305 a_temp(1,1)=aggi1(l,1)
4306 a_temp(1,2)=aggi1(l,2)
4307 a_temp(2,1)=aggi1(l,3)
4308 a_temp(2,2)=aggi1(l,4)
4309 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4310 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4311 & +0.5d0*(pizda(1,1)+pizda(2,2))
4312 a_temp(1,1)=aggj(l,1)
4313 a_temp(1,2)=aggj(l,2)
4314 a_temp(2,1)=aggj(l,3)
4315 a_temp(2,2)=aggj(l,4)
4316 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4317 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4318 & +0.5d0*(pizda(1,1)+pizda(2,2))
4319 a_temp(1,1)=aggj1(l,1)
4320 a_temp(1,2)=aggj1(l,2)
4321 a_temp(2,1)=aggj1(l,3)
4322 a_temp(2,2)=aggj1(l,4)
4323 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4324 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4325 & +0.5d0*(pizda(1,1)+pizda(2,2))
4328 else if (j.eq.i+3) then
4329 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4331 C Fourth-order contributions
4339 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4340 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4341 iti1=itortyp(itype(i+1))
4342 iti2=itortyp(itype(i+2))
4343 iti3=itortyp(itype(i+3))
4344 call transpose2(EUg(1,1,i+1),e1t(1,1))
4345 call transpose2(Eug(1,1,i+2),e2t(1,1))
4346 call transpose2(Eug(1,1,i+3),e3t(1,1))
4347 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4348 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4349 s1=scalar2(b1(1,iti2),auxvec(1))
4350 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4351 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4352 s2=scalar2(b1(1,iti1),auxvec(1))
4353 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4354 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4355 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4356 eello_turn4=eello_turn4-(s1+s2+s3)
4357 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4358 cd & ' eello_turn4_num',8*eello_turn4_num
4359 C Derivatives in gamma(i)
4361 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4362 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4363 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4364 s1=scalar2(b1(1,iti2),auxvec(1))
4365 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4366 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4367 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4368 C Derivatives in gamma(i+1)
4369 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4370 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4371 s2=scalar2(b1(1,iti1),auxvec(1))
4372 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4373 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4374 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4375 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4376 C Derivatives in gamma(i+2)
4377 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4378 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4379 s1=scalar2(b1(1,iti2),auxvec(1))
4380 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4381 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4382 s2=scalar2(b1(1,iti1),auxvec(1))
4383 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
4384 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4385 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4386 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4387 C Cartesian derivatives
4388 C Derivatives of this turn contributions in DC(i+2)
4389 if (j.lt.nres-1) then
4391 a_temp(1,1)=agg(l,1)
4392 a_temp(1,2)=agg(l,2)
4393 a_temp(2,1)=agg(l,3)
4394 a_temp(2,2)=agg(l,4)
4395 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4396 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4397 s1=scalar2(b1(1,iti2),auxvec(1))
4398 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4399 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4400 s2=scalar2(b1(1,iti1),auxvec(1))
4401 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4402 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4403 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4405 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4408 C Remaining derivatives of this turn contribution
4410 a_temp(1,1)=aggi(l,1)
4411 a_temp(1,2)=aggi(l,2)
4412 a_temp(2,1)=aggi(l,3)
4413 a_temp(2,2)=aggi(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,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4424 a_temp(1,1)=aggi1(l,1)
4425 a_temp(1,2)=aggi1(l,2)
4426 a_temp(2,1)=aggi1(l,3)
4427 a_temp(2,2)=aggi1(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,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4438 a_temp(1,1)=aggj(l,1)
4439 a_temp(1,2)=aggj(l,2)
4440 a_temp(2,1)=aggj(l,3)
4441 a_temp(2,2)=aggj(l,4)
4442 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4443 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4444 s1=scalar2(b1(1,iti2),auxvec(1))
4445 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4446 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4447 s2=scalar2(b1(1,iti1),auxvec(1))
4448 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4449 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4450 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4451 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4452 a_temp(1,1)=aggj1(l,1)
4453 a_temp(1,2)=aggj1(l,2)
4454 a_temp(2,1)=aggj1(l,3)
4455 a_temp(2,2)=aggj1(l,4)
4456 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4457 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4458 s1=scalar2(b1(1,iti2),auxvec(1))
4459 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4460 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4461 s2=scalar2(b1(1,iti1),auxvec(1))
4462 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4463 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4464 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4465 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4471 C-----------------------------------------------------------------------------
4472 subroutine vecpr(u,v,w)
4473 implicit real*8(a-h,o-z)
4474 dimension u(3),v(3),w(3)
4475 w(1)=u(2)*v(3)-u(3)*v(2)
4476 w(2)=-u(1)*v(3)+u(3)*v(1)
4477 w(3)=u(1)*v(2)-u(2)*v(1)
4480 C-----------------------------------------------------------------------------
4481 subroutine unormderiv(u,ugrad,unorm,ungrad)
4482 C This subroutine computes the derivatives of a normalized vector u, given
4483 C the derivatives computed without normalization conditions, ugrad. Returns
4486 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4487 double precision vec(3)
4488 double precision scalar
4490 c write (2,*) 'ugrad',ugrad
4493 vec(i)=scalar(ugrad(1,i),u(1))
4495 c write (2,*) 'vec',vec
4498 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4501 c write (2,*) 'ungrad',ungrad
4504 C-----------------------------------------------------------------------------
4505 subroutine escp(evdw2,evdw2_14)
4507 C This subroutine calculates the excluded-volume interaction energy between
4508 C peptide-group centers and side chains and its gradient in virtual-bond and
4509 C side-chain vectors.
4511 implicit real*8 (a-h,o-z)
4512 include 'DIMENSIONS'
4513 include 'DIMENSIONS.ZSCOPT'
4514 include 'COMMON.GEO'
4515 include 'COMMON.VAR'
4516 include 'COMMON.LOCAL'
4517 include 'COMMON.CHAIN'
4518 include 'COMMON.DERIV'
4519 include 'COMMON.INTERACT'
4520 include 'COMMON.FFIELD'
4521 include 'COMMON.IOUNITS'
4525 cd print '(a)','Enter ESCP'
4526 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4527 c & ' scal14',scal14
4528 do i=iatscp_s,iatscp_e
4530 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4531 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4532 if (iteli.eq.0) goto 1225
4533 xi=0.5D0*(c(1,i)+c(1,i+1))
4534 yi=0.5D0*(c(2,i)+c(2,i+1))
4535 zi=0.5D0*(c(3,i)+c(3,i+1))
4537 do iint=1,nscp_gr(i)
4539 do j=iscpstart(i,iint),iscpend(i,iint)
4541 C Uncomment following three lines for SC-p interactions
4545 C Uncomment following three lines for Ca-p interactions
4549 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4551 e1=fac*fac*aad(itypj,iteli)
4552 e2=fac*bad(itypj,iteli)
4553 if (iabs(j-i) .le. 2) then
4556 evdw2_14=evdw2_14+e1+e2
4559 c write (iout,*) i,j,evdwij
4563 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4565 fac=-(evdwij+e1)*rrij
4570 cd write (iout,*) 'j<i'
4571 C Uncomment following three lines for SC-p interactions
4573 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4576 cd write (iout,*) 'j>i'
4579 C Uncomment following line for SC-p interactions
4580 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4584 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4588 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4589 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4592 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4602 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4603 gradx_scp(j,i)=expon*gradx_scp(j,i)
4606 C******************************************************************************
4610 C To save time the factor EXPON has been extracted from ALL components
4611 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4614 C******************************************************************************
4617 C--------------------------------------------------------------------------
4618 subroutine edis(ehpb)
4620 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4622 implicit real*8 (a-h,o-z)
4623 include 'DIMENSIONS'
4624 include 'COMMON.SBRIDGE'
4625 include 'COMMON.CHAIN'
4626 include 'COMMON.DERIV'
4627 include 'COMMON.VAR'
4628 include 'COMMON.INTERACT'
4629 include 'COMMON.IOUNITS'
4632 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4633 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4634 if (link_end.eq.0) return
4635 do i=link_start,link_end
4636 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4637 C CA-CA distance used in regularization of structure.
4640 C iii and jjj point to the residues for which the distance is assigned.
4641 if (ii.gt.nres) then
4648 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4649 c & dhpb(i),dhpb1(i),forcon(i)
4650 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4651 C distance and angle dependent SS bond potential.
4652 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4653 call ssbond_ene(iii,jjj,eij)
4655 cd write (iout,*) "eij",eij
4656 else if (ii.gt.nres .and. jj.gt.nres) then
4657 c Restraints from contact prediction
4659 if (dhpb1(i).gt.0.0d0) then
4660 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4661 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4662 c write (iout,*) "beta nmr",
4663 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4667 C Get the force constant corresponding to this distance.
4669 C Calculate the contribution to energy.
4670 ehpb=ehpb+waga*rdis*rdis
4671 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4673 C Evaluate gradient.
4678 ggg(j)=fac*(c(j,jj)-c(j,ii))
4681 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4682 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4685 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4686 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4689 C Calculate the distance between the two points and its difference from the
4692 if (dhpb1(i).gt.0.0d0) then
4693 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4694 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4695 c write (iout,*) "alph nmr",
4696 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4699 C Get the force constant corresponding to this distance.
4701 C Calculate the contribution to energy.
4702 ehpb=ehpb+waga*rdis*rdis
4703 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4705 C Evaluate gradient.
4709 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4710 cd & ' waga=',waga,' fac=',fac
4712 ggg(j)=fac*(c(j,jj)-c(j,ii))
4714 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4715 C If this is a SC-SC distance, we need to calculate the contributions to the
4716 C Cartesian gradient in the SC vectors (ghpbx).
4719 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4720 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4724 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4725 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4732 C--------------------------------------------------------------------------
4733 subroutine ssbond_ene(i,j,eij)
4735 C Calculate the distance and angle dependent SS-bond potential energy
4736 C using a free-energy function derived based on RHF/6-31G** ab initio
4737 C calculations of diethyl disulfide.
4739 C A. Liwo and U. Kozlowska, 11/24/03
4741 implicit real*8 (a-h,o-z)
4742 include 'DIMENSIONS'
4743 include 'DIMENSIONS.ZSCOPT'
4744 include 'COMMON.SBRIDGE'
4745 include 'COMMON.CHAIN'
4746 include 'COMMON.DERIV'
4747 include 'COMMON.LOCAL'
4748 include 'COMMON.INTERACT'
4749 include 'COMMON.VAR'
4750 include 'COMMON.IOUNITS'
4751 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4756 dxi=dc_norm(1,nres+i)
4757 dyi=dc_norm(2,nres+i)
4758 dzi=dc_norm(3,nres+i)
4759 dsci_inv=dsc_inv(itypi)
4761 dscj_inv=dsc_inv(itypj)
4765 dxj=dc_norm(1,nres+j)
4766 dyj=dc_norm(2,nres+j)
4767 dzj=dc_norm(3,nres+j)
4768 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4773 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4774 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4775 om12=dxi*dxj+dyi*dyj+dzi*dzj
4777 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4778 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4784 deltat12=om2-om1+2.0d0
4786 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4787 & +akct*deltad*deltat12
4788 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4789 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4790 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4791 c & " deltat12",deltat12," eij",eij
4792 ed=2*akcm*deltad+akct*deltat12
4794 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4795 eom1=-2*akth*deltat1-pom1-om2*pom2
4796 eom2= 2*akth*deltat2+pom1-om1*pom2
4799 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4802 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4803 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4804 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4805 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4808 C Calculate the components of the gradient in DC and X
4812 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4817 C--------------------------------------------------------------------------
4818 subroutine ebond(estr)
4820 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4822 implicit real*8 (a-h,o-z)
4823 include 'DIMENSIONS'
4824 include 'DIMENSIONS.ZSCOPT'
4825 include 'COMMON.LOCAL'
4826 include 'COMMON.GEO'
4827 include 'COMMON.INTERACT'
4828 include 'COMMON.DERIV'
4829 include 'COMMON.VAR'
4830 include 'COMMON.CHAIN'
4831 include 'COMMON.IOUNITS'
4832 include 'COMMON.NAMES'
4833 include 'COMMON.FFIELD'
4834 include 'COMMON.CONTROL'
4835 double precision u(3),ud(3)
4838 diff = vbld(i)-vbldp0
4839 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4842 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4847 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4854 diff=vbld(i+nres)-vbldsc0(1,iti)
4855 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4856 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4857 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4859 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4863 diff=vbld(i+nres)-vbldsc0(j,iti)
4864 ud(j)=aksc(j,iti)*diff
4865 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4879 uprod2=uprod2*u(k)*u(k)
4883 usumsqder=usumsqder+ud(j)*uprod2
4885 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4886 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4887 estr=estr+uprod/usum
4889 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4897 C--------------------------------------------------------------------------
4898 subroutine ebend(etheta)
4900 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4901 C angles gamma and its derivatives in consecutive thetas and gammas.
4903 implicit real*8 (a-h,o-z)
4904 include 'DIMENSIONS'
4905 include 'DIMENSIONS.ZSCOPT'
4906 include 'COMMON.LOCAL'
4907 include 'COMMON.GEO'
4908 include 'COMMON.INTERACT'
4909 include 'COMMON.DERIV'
4910 include 'COMMON.VAR'
4911 include 'COMMON.CHAIN'
4912 include 'COMMON.IOUNITS'
4913 include 'COMMON.NAMES'
4914 include 'COMMON.FFIELD'
4915 common /calcthet/ term1,term2,termm,diffak,ratak,
4916 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4917 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4918 double precision y(2),z(2)
4920 time11=dexp(-2*time)
4923 c write (iout,*) "nres",nres
4924 c write (*,'(a,i2)') 'EBEND ICG=',icg
4925 c write (iout,*) ithet_start,ithet_end
4926 do i=ithet_start,ithet_end
4927 C Zero the energy function and its derivative at 0 or pi.
4928 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4930 c if (i.gt.ithet_start .and.
4931 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
4932 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
4940 c if (i.lt.nres .and. itel(i).ne.0) then
4952 call proc_proc(phii,icrc)
4953 if (icrc.eq.1) phii=150.0
4967 call proc_proc(phii1,icrc)
4968 if (icrc.eq.1) phii1=150.0
4980 C Calculate the "mean" value of theta from the part of the distribution
4981 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4982 C In following comments this theta will be referred to as t_c.
4983 thet_pred_mean=0.0d0
4987 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4989 c write (iout,*) "thet_pred_mean",thet_pred_mean
4990 dthett=thet_pred_mean*ssd
4991 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4992 c write (iout,*) "thet_pred_mean",thet_pred_mean
4993 C Derivatives of the "mean" values in gamma1 and gamma2.
4994 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4995 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4996 if (theta(i).gt.pi-delta) then
4997 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4999 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5000 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5001 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5003 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5005 else if (theta(i).lt.delta) then
5006 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5007 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5008 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5010 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5011 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5014 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5017 etheta=etheta+ethetai
5018 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
5019 c & rad2deg*phii,rad2deg*phii1,ethetai
5020 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5021 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5022 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5025 C Ufff.... We've done all this!!!
5028 C---------------------------------------------------------------------------
5029 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5031 implicit real*8 (a-h,o-z)
5032 include 'DIMENSIONS'
5033 include 'COMMON.LOCAL'
5034 include 'COMMON.IOUNITS'
5035 common /calcthet/ term1,term2,termm,diffak,ratak,
5036 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5037 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5038 C Calculate the contributions to both Gaussian lobes.
5039 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5040 C The "polynomial part" of the "standard deviation" of this part of
5044 sig=sig*thet_pred_mean+polthet(j,it)
5046 C Derivative of the "interior part" of the "standard deviation of the"
5047 C gamma-dependent Gaussian lobe in t_c.
5048 sigtc=3*polthet(3,it)
5050 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5053 C Set the parameters of both Gaussian lobes of the distribution.
5054 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5055 fac=sig*sig+sigc0(it)
5058 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5059 sigsqtc=-4.0D0*sigcsq*sigtc
5060 c print *,i,sig,sigtc,sigsqtc
5061 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5062 sigtc=-sigtc/(fac*fac)
5063 C Following variable is sigma(t_c)**(-2)
5064 sigcsq=sigcsq*sigcsq
5066 sig0inv=1.0D0/sig0i**2
5067 delthec=thetai-thet_pred_mean
5068 delthe0=thetai-theta0i
5069 term1=-0.5D0*sigcsq*delthec*delthec
5070 term2=-0.5D0*sig0inv*delthe0*delthe0
5071 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5072 C NaNs in taking the logarithm. We extract the largest exponent which is added
5073 C to the energy (this being the log of the distribution) at the end of energy
5074 C term evaluation for this virtual-bond angle.
5075 if (term1.gt.term2) then
5077 term2=dexp(term2-termm)
5081 term1=dexp(term1-termm)
5084 C The ratio between the gamma-independent and gamma-dependent lobes of
5085 C the distribution is a Gaussian function of thet_pred_mean too.
5086 diffak=gthet(2,it)-thet_pred_mean
5087 ratak=diffak/gthet(3,it)**2
5088 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5089 C Let's differentiate it in thet_pred_mean NOW.
5091 C Now put together the distribution terms to make complete distribution.
5092 termexp=term1+ak*term2
5093 termpre=sigc+ak*sig0i
5094 C Contribution of the bending energy from this theta is just the -log of
5095 C the sum of the contributions from the two lobes and the pre-exponential
5096 C factor. Simple enough, isn't it?
5097 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5098 C NOW the derivatives!!!
5099 C 6/6/97 Take into account the deformation.
5100 E_theta=(delthec*sigcsq*term1
5101 & +ak*delthe0*sig0inv*term2)/termexp
5102 E_tc=((sigtc+aktc*sig0i)/termpre
5103 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5104 & aktc*term2)/termexp)
5107 c-----------------------------------------------------------------------------
5108 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5109 implicit real*8 (a-h,o-z)
5110 include 'DIMENSIONS'
5111 include 'COMMON.LOCAL'
5112 include 'COMMON.IOUNITS'
5113 common /calcthet/ term1,term2,termm,diffak,ratak,
5114 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5115 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5116 delthec=thetai-thet_pred_mean
5117 delthe0=thetai-theta0i
5118 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5119 t3 = thetai-thet_pred_mean
5123 t14 = t12+t6*sigsqtc
5125 t21 = thetai-theta0i
5131 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5132 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5133 & *(-t12*t9-ak*sig0inv*t27)
5137 C--------------------------------------------------------------------------
5138 subroutine ebend(etheta)
5140 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5141 C angles gamma and its derivatives in consecutive thetas and gammas.
5142 C ab initio-derived potentials from
5143 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5145 implicit real*8 (a-h,o-z)
5146 include 'DIMENSIONS'
5147 include 'DIMENSIONS.ZSCOPT'
5148 include 'COMMON.LOCAL'
5149 include 'COMMON.GEO'
5150 include 'COMMON.INTERACT'
5151 include 'COMMON.DERIV'
5152 include 'COMMON.VAR'
5153 include 'COMMON.CHAIN'
5154 include 'COMMON.IOUNITS'
5155 include 'COMMON.NAMES'
5156 include 'COMMON.FFIELD'
5157 include 'COMMON.CONTROL'
5158 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5159 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5160 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5161 & sinph1ph2(maxdouble,maxdouble)
5162 logical lprn /.false./, lprn1 /.false./
5164 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5165 do i=ithet_start,ithet_end
5169 theti2=0.5d0*theta(i)
5170 ityp2=ithetyp(itype(i-1))
5172 coskt(k)=dcos(k*theti2)
5173 sinkt(k)=dsin(k*theti2)
5178 if (phii.ne.phii) phii=150.0
5182 ityp1=ithetyp(itype(i-2))
5184 cosph1(k)=dcos(k*phii)
5185 sinph1(k)=dsin(k*phii)
5198 if (phii1.ne.phii1) phii1=150.0
5203 ityp3=ithetyp(itype(i))
5205 cosph2(k)=dcos(k*phii1)
5206 sinph2(k)=dsin(k*phii1)
5216 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5217 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5219 ethetai=aa0thet(ityp1,ityp2,ityp3)
5222 ccl=cosph1(l)*cosph2(k-l)
5223 ssl=sinph1(l)*sinph2(k-l)
5224 scl=sinph1(l)*cosph2(k-l)
5225 csl=cosph1(l)*sinph2(k-l)
5226 cosph1ph2(l,k)=ccl-ssl
5227 cosph1ph2(k,l)=ccl+ssl
5228 sinph1ph2(l,k)=scl+csl
5229 sinph1ph2(k,l)=scl-csl
5233 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5234 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5235 write (iout,*) "coskt and sinkt"
5237 write (iout,*) k,coskt(k),sinkt(k)
5241 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
5242 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
5245 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
5246 & " ethetai",ethetai
5249 write (iout,*) "cosph and sinph"
5251 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5253 write (iout,*) "cosph1ph2 and sinph2ph2"
5256 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5257 & sinph1ph2(l,k),sinph1ph2(k,l)
5260 write(iout,*) "ethetai",ethetai
5264 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
5265 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
5266 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
5267 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
5268 ethetai=ethetai+sinkt(m)*aux
5269 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5270 dephii=dephii+k*sinkt(m)*(
5271 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
5272 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
5273 dephii1=dephii1+k*sinkt(m)*(
5274 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
5275 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
5277 & write (iout,*) "m",m," k",k," bbthet",
5278 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
5279 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
5280 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
5281 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5285 & write(iout,*) "ethetai",ethetai
5289 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5290 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
5291 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5292 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
5293 ethetai=ethetai+sinkt(m)*aux
5294 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5295 dephii=dephii+l*sinkt(m)*(
5296 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
5297 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5298 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5299 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5300 dephii1=dephii1+(k-l)*sinkt(m)*(
5301 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5302 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5303 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5304 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5306 write (iout,*) "m",m," k",k," l",l," ffthet",
5307 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5308 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5309 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5310 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5311 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5312 & cosph1ph2(k,l)*sinkt(m),
5313 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5319 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5320 & i,theta(i)*rad2deg,phii*rad2deg,
5321 & phii1*rad2deg,ethetai
5322 etheta=etheta+ethetai
5323 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5324 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5325 gloc(nphi+i-2,icg)=wang*dethetai
5331 c-----------------------------------------------------------------------------
5332 subroutine esc(escloc)
5333 C Calculate the local energy of a side chain and its derivatives in the
5334 C corresponding virtual-bond valence angles THETA and the spherical angles
5336 implicit real*8 (a-h,o-z)
5337 include 'DIMENSIONS'
5338 include 'DIMENSIONS.ZSCOPT'
5339 include 'COMMON.GEO'
5340 include 'COMMON.LOCAL'
5341 include 'COMMON.VAR'
5342 include 'COMMON.INTERACT'
5343 include 'COMMON.DERIV'
5344 include 'COMMON.CHAIN'
5345 include 'COMMON.IOUNITS'
5346 include 'COMMON.NAMES'
5347 include 'COMMON.FFIELD'
5348 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5349 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5350 common /sccalc/ time11,time12,time112,theti,it,nlobit
5353 c write (iout,'(a)') 'ESC'
5354 do i=loc_start,loc_end
5356 if (it.eq.10) goto 1
5358 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5359 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5360 theti=theta(i+1)-pipol
5364 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5366 if (x(2).gt.pi-delta) then
5370 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5372 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5373 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5375 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5376 & ddersc0(1),dersc(1))
5377 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5378 & ddersc0(3),dersc(3))
5380 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5382 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5383 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5384 & dersc0(2),esclocbi,dersc02)
5385 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5387 call splinthet(x(2),0.5d0*delta,ss,ssd)
5392 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5394 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5395 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5397 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5399 c write (iout,*) escloci
5400 else if (x(2).lt.delta) then
5404 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5406 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5407 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5409 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5410 & ddersc0(1),dersc(1))
5411 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5412 & ddersc0(3),dersc(3))
5414 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5416 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5417 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5418 & dersc0(2),esclocbi,dersc02)
5419 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5424 call splinthet(x(2),0.5d0*delta,ss,ssd)
5426 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5428 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5429 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5431 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5432 c write (iout,*) escloci
5434 call enesc(x,escloci,dersc,ddummy,.false.)
5437 escloc=escloc+escloci
5438 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5440 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5442 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5443 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5448 C---------------------------------------------------------------------------
5449 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5450 implicit real*8 (a-h,o-z)
5451 include 'DIMENSIONS'
5452 include 'COMMON.GEO'
5453 include 'COMMON.LOCAL'
5454 include 'COMMON.IOUNITS'
5455 common /sccalc/ time11,time12,time112,theti,it,nlobit
5456 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5457 double precision contr(maxlob,-1:1)
5459 c write (iout,*) 'it=',it,' nlobit=',nlobit
5463 if (mixed) ddersc(j)=0.0d0
5467 C Because of periodicity of the dependence of the SC energy in omega we have
5468 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5469 C To avoid underflows, first compute & store the exponents.
5477 z(k)=x(k)-censc(k,j,it)
5482 Axk=Axk+gaussc(l,k,j,it)*z(l)
5488 expfac=expfac+Ax(k,j,iii)*z(k)
5496 C As in the case of ebend, we want to avoid underflows in exponentiation and
5497 C subsequent NaNs and INFs in energy calculation.
5498 C Find the largest exponent
5502 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5506 cd print *,'it=',it,' emin=',emin
5508 C Compute the contribution to SC energy and derivatives
5512 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5513 cd print *,'j=',j,' expfac=',expfac
5514 escloc_i=escloc_i+expfac
5516 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5520 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5521 & +gaussc(k,2,j,it))*expfac
5528 dersc(1)=dersc(1)/cos(theti)**2
5529 ddersc(1)=ddersc(1)/cos(theti)**2
5532 escloci=-(dlog(escloc_i)-emin)
5534 dersc(j)=dersc(j)/escloc_i
5538 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5543 C------------------------------------------------------------------------------
5544 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5545 implicit real*8 (a-h,o-z)
5546 include 'DIMENSIONS'
5547 include 'COMMON.GEO'
5548 include 'COMMON.LOCAL'
5549 include 'COMMON.IOUNITS'
5550 common /sccalc/ time11,time12,time112,theti,it,nlobit
5551 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5552 double precision contr(maxlob)
5563 z(k)=x(k)-censc(k,j,it)
5569 Axk=Axk+gaussc(l,k,j,it)*z(l)
5575 expfac=expfac+Ax(k,j)*z(k)
5580 C As in the case of ebend, we want to avoid underflows in exponentiation and
5581 C subsequent NaNs and INFs in energy calculation.
5582 C Find the largest exponent
5585 if (emin.gt.contr(j)) emin=contr(j)
5589 C Compute the contribution to SC energy and derivatives
5593 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5594 escloc_i=escloc_i+expfac
5596 dersc(k)=dersc(k)+Ax(k,j)*expfac
5598 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5599 & +gaussc(1,2,j,it))*expfac
5603 dersc(1)=dersc(1)/cos(theti)**2
5604 dersc12=dersc12/cos(theti)**2
5605 escloci=-(dlog(escloc_i)-emin)
5607 dersc(j)=dersc(j)/escloc_i
5609 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5613 c----------------------------------------------------------------------------------
5614 subroutine esc(escloc)
5615 C Calculate the local energy of a side chain and its derivatives in the
5616 C corresponding virtual-bond valence angles THETA and the spherical angles
5617 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5618 C added by Urszula Kozlowska. 07/11/2007
5620 implicit real*8 (a-h,o-z)
5621 include 'DIMENSIONS'
5622 include 'DIMENSIONS.ZSCOPT'
5623 include 'COMMON.GEO'
5624 include 'COMMON.LOCAL'
5625 include 'COMMON.VAR'
5626 include 'COMMON.SCROT'
5627 include 'COMMON.INTERACT'
5628 include 'COMMON.DERIV'
5629 include 'COMMON.CHAIN'
5630 include 'COMMON.IOUNITS'
5631 include 'COMMON.NAMES'
5632 include 'COMMON.FFIELD'
5633 include 'COMMON.CONTROL'
5634 include 'COMMON.VECTORS'
5635 double precision x_prime(3),y_prime(3),z_prime(3)
5636 & , sumene,dsc_i,dp2_i,x(65),
5637 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5638 & de_dxx,de_dyy,de_dzz,de_dt
5639 double precision s1_t,s1_6_t,s2_t,s2_6_t
5641 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5642 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5643 & dt_dCi(3),dt_dCi1(3)
5644 common /sccalc/ time11,time12,time112,theti,it,nlobit
5647 do i=loc_start,loc_end
5648 costtab(i+1) =dcos(theta(i+1))
5649 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5650 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5651 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5652 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5653 cosfac=dsqrt(cosfac2)
5654 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5655 sinfac=dsqrt(sinfac2)
5657 if (it.eq.10) goto 1
5659 C Compute the axes of tghe local cartesian coordinates system; store in
5660 c x_prime, y_prime and z_prime
5667 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5668 C & dc_norm(3,i+nres)
5670 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5671 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5674 z_prime(j) = -uz(j,i-1)
5677 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5678 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5679 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5680 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5681 c & " xy",scalar(x_prime(1),y_prime(1)),
5682 c & " xz",scalar(x_prime(1),z_prime(1)),
5683 c & " yy",scalar(y_prime(1),y_prime(1)),
5684 c & " yz",scalar(y_prime(1),z_prime(1)),
5685 c & " zz",scalar(z_prime(1),z_prime(1))
5687 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5688 C to local coordinate system. Store in xx, yy, zz.
5694 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5695 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5696 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5703 C Compute the energy of the ith side cbain
5705 c write (2,*) "xx",xx," yy",yy," zz",zz
5708 x(j) = sc_parmin(j,it)
5711 Cc diagnostics - remove later
5713 yy1 = dsin(alph(2))*dcos(omeg(2))
5714 zz1 = -dsin(alph(2))*dsin(omeg(2))
5715 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5716 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5718 C," --- ", xx_w,yy_w,zz_w
5721 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5722 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5724 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5725 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5727 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5728 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5729 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5730 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5731 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5733 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5734 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5735 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5736 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5737 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5739 dsc_i = 0.743d0+x(61)
5741 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5742 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5743 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5744 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5745 s1=(1+x(63))/(0.1d0 + dscp1)
5746 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5747 s2=(1+x(65))/(0.1d0 + dscp2)
5748 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5749 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5750 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5751 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5753 c & dscp1,dscp2,sumene
5754 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5755 escloc = escloc + sumene
5756 c write (2,*) "escloc",escloc
5757 if (.not. calc_grad) goto 1
5760 C This section to check the numerical derivatives of the energy of ith side
5761 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5762 C #define DEBUG in the code to turn it on.
5764 write (2,*) "sumene =",sumene
5768 write (2,*) xx,yy,zz
5769 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5770 de_dxx_num=(sumenep-sumene)/aincr
5772 write (2,*) "xx+ sumene from enesc=",sumenep
5775 write (2,*) xx,yy,zz
5776 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5777 de_dyy_num=(sumenep-sumene)/aincr
5779 write (2,*) "yy+ sumene from enesc=",sumenep
5782 write (2,*) xx,yy,zz
5783 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5784 de_dzz_num=(sumenep-sumene)/aincr
5786 write (2,*) "zz+ sumene from enesc=",sumenep
5787 costsave=cost2tab(i+1)
5788 sintsave=sint2tab(i+1)
5789 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5790 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5791 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5792 de_dt_num=(sumenep-sumene)/aincr
5793 write (2,*) " t+ sumene from enesc=",sumenep
5794 cost2tab(i+1)=costsave
5795 sint2tab(i+1)=sintsave
5796 C End of diagnostics section.
5799 C Compute the gradient of esc
5801 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5802 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5803 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5804 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5805 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5806 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5807 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5808 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5809 pom1=(sumene3*sint2tab(i+1)+sumene1)
5810 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5811 pom2=(sumene4*cost2tab(i+1)+sumene2)
5812 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5813 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5814 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5815 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5817 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5818 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5819 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5821 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5822 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5823 & +(pom1+pom2)*pom_dx
5825 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5828 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5829 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5830 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5832 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5833 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5834 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5835 & +x(59)*zz**2 +x(60)*xx*zz
5836 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5837 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5838 & +(pom1-pom2)*pom_dy
5840 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5843 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5844 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5845 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5846 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5847 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5848 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5849 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5850 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5852 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5855 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5856 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5857 & +pom1*pom_dt1+pom2*pom_dt2
5859 write(2,*), "de_dt = ", de_dt,de_dt_num
5863 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5864 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5865 cosfac2xx=cosfac2*xx
5866 sinfac2yy=sinfac2*yy
5868 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5870 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5872 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5873 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5874 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5875 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5876 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5877 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5878 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5879 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5880 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5881 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5885 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5886 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5889 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5890 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5891 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5893 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5894 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5898 dXX_Ctab(k,i)=dXX_Ci(k)
5899 dXX_C1tab(k,i)=dXX_Ci1(k)
5900 dYY_Ctab(k,i)=dYY_Ci(k)
5901 dYY_C1tab(k,i)=dYY_Ci1(k)
5902 dZZ_Ctab(k,i)=dZZ_Ci(k)
5903 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5904 dXX_XYZtab(k,i)=dXX_XYZ(k)
5905 dYY_XYZtab(k,i)=dYY_XYZ(k)
5906 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5910 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5911 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5912 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5913 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5914 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5916 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5917 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5918 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5919 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5920 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5921 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5922 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5923 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5925 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5926 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5928 C to check gradient call subroutine check_grad
5935 c------------------------------------------------------------------------------
5936 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5938 C This procedure calculates two-body contact function g(rij) and its derivative:
5941 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5944 C where x=(rij-r0ij)/delta
5946 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5949 double precision rij,r0ij,eps0ij,fcont,fprimcont
5950 double precision x,x2,x4,delta
5954 if (x.lt.-1.0D0) then
5957 else if (x.le.1.0D0) then
5960 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5961 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5968 c------------------------------------------------------------------------------
5969 subroutine splinthet(theti,delta,ss,ssder)
5970 implicit real*8 (a-h,o-z)
5971 include 'DIMENSIONS'
5972 include 'DIMENSIONS.ZSCOPT'
5973 include 'COMMON.VAR'
5974 include 'COMMON.GEO'
5977 if (theti.gt.pipol) then
5978 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5980 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5985 c------------------------------------------------------------------------------
5986 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5988 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5989 double precision ksi,ksi2,ksi3,a1,a2,a3
5990 a1=fprim0*delta/(f1-f0)
5996 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5997 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6000 c------------------------------------------------------------------------------
6001 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6003 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6004 double precision ksi,ksi2,ksi3,a1,a2,a3
6009 a2=3*(f1x-f0x)-2*fprim0x*delta
6010 a3=fprim0x*delta-2*(f1x-f0x)
6011 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6014 C-----------------------------------------------------------------------------
6016 C-----------------------------------------------------------------------------
6017 subroutine etor(etors,edihcnstr,fact)
6018 implicit real*8 (a-h,o-z)
6019 include 'DIMENSIONS'
6020 include 'DIMENSIONS.ZSCOPT'
6021 include 'COMMON.VAR'
6022 include 'COMMON.GEO'
6023 include 'COMMON.LOCAL'
6024 include 'COMMON.TORSION'
6025 include 'COMMON.INTERACT'
6026 include 'COMMON.DERIV'
6027 include 'COMMON.CHAIN'
6028 include 'COMMON.NAMES'
6029 include 'COMMON.IOUNITS'
6030 include 'COMMON.FFIELD'
6031 include 'COMMON.TORCNSTR'
6033 C Set lprn=.true. for debugging
6037 do i=iphi_start,iphi_end
6038 itori=itortyp(itype(i-2))
6039 itori1=itortyp(itype(i-1))
6042 C Proline-Proline pair is a special case...
6043 if (itori.eq.3 .and. itori1.eq.3) then
6044 if (phii.gt.-dwapi3) then
6046 fac=1.0D0/(1.0D0-cosphi)
6047 etorsi=v1(1,3,3)*fac
6048 etorsi=etorsi+etorsi
6049 etors=etors+etorsi-v1(1,3,3)
6050 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6053 v1ij=v1(j+1,itori,itori1)
6054 v2ij=v2(j+1,itori,itori1)
6057 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6058 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6062 v1ij=v1(j,itori,itori1)
6063 v2ij=v2(j,itori,itori1)
6066 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6067 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6071 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6072 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6073 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6074 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6075 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6077 ! 6/20/98 - dihedral angle constraints
6080 itori=idih_constr(i)
6083 if (difi.gt.drange(i)) then
6085 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6086 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6087 else if (difi.lt.-drange(i)) then
6089 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6090 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6092 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6093 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6095 ! write (iout,*) 'edihcnstr',edihcnstr
6098 c------------------------------------------------------------------------------
6100 subroutine etor(etors,edihcnstr,fact)
6101 implicit real*8 (a-h,o-z)
6102 include 'DIMENSIONS'
6103 include 'DIMENSIONS.ZSCOPT'
6104 include 'COMMON.VAR'
6105 include 'COMMON.GEO'
6106 include 'COMMON.LOCAL'
6107 include 'COMMON.TORSION'
6108 include 'COMMON.INTERACT'
6109 include 'COMMON.DERIV'
6110 include 'COMMON.CHAIN'
6111 include 'COMMON.NAMES'
6112 include 'COMMON.IOUNITS'
6113 include 'COMMON.FFIELD'
6114 include 'COMMON.TORCNSTR'
6116 C Set lprn=.true. for debugging
6120 do i=iphi_start,iphi_end
6121 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6122 itori=itortyp(itype(i-2))
6123 itori1=itortyp(itype(i-1))
6126 C Regular cosine and sine terms
6127 do j=1,nterm(itori,itori1)
6128 v1ij=v1(j,itori,itori1)
6129 v2ij=v2(j,itori,itori1)
6132 etors=etors+v1ij*cosphi+v2ij*sinphi
6133 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6137 C E = SUM ----------------------------------- - v1
6138 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6140 cosphi=dcos(0.5d0*phii)
6141 sinphi=dsin(0.5d0*phii)
6142 do j=1,nlor(itori,itori1)
6143 vl1ij=vlor1(j,itori,itori1)
6144 vl2ij=vlor2(j,itori,itori1)
6145 vl3ij=vlor3(j,itori,itori1)
6146 pom=vl2ij*cosphi+vl3ij*sinphi
6147 pom1=1.0d0/(pom*pom+1.0d0)
6148 etors=etors+vl1ij*pom1
6150 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6152 C Subtract the constant term
6153 etors=etors-v0(itori,itori1)
6155 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6156 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6157 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6158 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6159 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6162 ! 6/20/98 - dihedral angle constraints
6165 itori=idih_constr(i)
6167 difi=pinorm(phii-phi0(i))
6169 if (difi.gt.drange(i)) then
6171 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6172 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6173 edihi=0.25d0*ftors*difi**4
6174 else if (difi.lt.-drange(i)) then
6176 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6177 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6178 edihi=0.25d0*ftors*difi**4
6182 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
6184 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6185 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6187 ! write (iout,*) 'edihcnstr',edihcnstr
6190 c----------------------------------------------------------------------------
6191 subroutine etor_d(etors_d,fact2)
6192 C 6/23/01 Compute double torsional energy
6193 implicit real*8 (a-h,o-z)
6194 include 'DIMENSIONS'
6195 include 'DIMENSIONS.ZSCOPT'
6196 include 'COMMON.VAR'
6197 include 'COMMON.GEO'
6198 include 'COMMON.LOCAL'
6199 include 'COMMON.TORSION'
6200 include 'COMMON.INTERACT'
6201 include 'COMMON.DERIV'
6202 include 'COMMON.CHAIN'
6203 include 'COMMON.NAMES'
6204 include 'COMMON.IOUNITS'
6205 include 'COMMON.FFIELD'
6206 include 'COMMON.TORCNSTR'
6208 C Set lprn=.true. for debugging
6212 do i=iphi_start,iphi_end-1
6213 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6215 itori=itortyp(itype(i-2))
6216 itori1=itortyp(itype(i-1))
6217 itori2=itortyp(itype(i))
6222 C Regular cosine and sine terms
6223 do j=1,ntermd_1(itori,itori1,itori2)
6224 v1cij=v1c(1,j,itori,itori1,itori2)
6225 v1sij=v1s(1,j,itori,itori1,itori2)
6226 v2cij=v1c(2,j,itori,itori1,itori2)
6227 v2sij=v1s(2,j,itori,itori1,itori2)
6228 cosphi1=dcos(j*phii)
6229 sinphi1=dsin(j*phii)
6230 cosphi2=dcos(j*phii1)
6231 sinphi2=dsin(j*phii1)
6232 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6233 & v2cij*cosphi2+v2sij*sinphi2
6234 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6235 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6237 do k=2,ntermd_2(itori,itori1,itori2)
6239 v1cdij = v2c(k,l,itori,itori1,itori2)
6240 v2cdij = v2c(l,k,itori,itori1,itori2)
6241 v1sdij = v2s(k,l,itori,itori1,itori2)
6242 v2sdij = v2s(l,k,itori,itori1,itori2)
6243 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6244 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6245 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6246 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6247 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6248 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6249 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6250 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6251 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6252 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6255 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6256 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6262 c------------------------------------------------------------------------------
6263 subroutine eback_sc_corr(esccor)
6264 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6265 c conformational states; temporarily implemented as differences
6266 c between UNRES torsional potentials (dependent on three types of
6267 c residues) and the torsional potentials dependent on all 20 types
6268 c of residues computed from AM1 energy surfaces of terminally-blocked
6269 c amino-acid residues.
6270 implicit real*8 (a-h,o-z)
6271 include 'DIMENSIONS'
6272 include 'DIMENSIONS.ZSCOPT'
6273 include 'COMMON.VAR'
6274 include 'COMMON.GEO'
6275 include 'COMMON.LOCAL'
6276 include 'COMMON.TORSION'
6277 include 'COMMON.SCCOR'
6278 include 'COMMON.INTERACT'
6279 include 'COMMON.DERIV'
6280 include 'COMMON.CHAIN'
6281 include 'COMMON.NAMES'
6282 include 'COMMON.IOUNITS'
6283 include 'COMMON.FFIELD'
6284 include 'COMMON.CONTROL'
6286 C Set lprn=.true. for debugging
6289 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
6291 do i=itau_start,itau_end
6293 isccori=isccortyp(itype(i-2))
6294 isccori1=isccortyp(itype(i-1))
6296 cccc Added 9 May 2012
6297 cc Tauangle is torsional engle depending on the value of first digit
6298 c(see comment below)
6299 cc Omicron is flat angle depending on the value of first digit
6300 c(see comment below)
6303 do intertyp=1,3 !intertyp
6304 cc Added 09 May 2012 (Adasko)
6305 cc Intertyp means interaction type of backbone mainchain correlation:
6306 c 1 = SC...Ca...Ca...Ca
6307 c 2 = Ca...Ca...Ca...SC
6308 c 3 = SC...Ca...Ca...SCi
6310 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6311 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6312 & (itype(i-1).eq.21)))
6313 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6314 & .or.(itype(i-2).eq.21)))
6315 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6316 & (itype(i-1).eq.21)))) cycle
6317 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6318 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6320 do j=1,nterm_sccor(isccori,isccori1)
6321 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6322 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6323 cosphi=dcos(j*tauangle(intertyp,i))
6324 sinphi=dsin(j*tauangle(intertyp,i))
6325 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6326 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6328 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6329 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6330 c &gloc_sc(intertyp,i-3,icg)
6332 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6333 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6334 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6335 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6336 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6340 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6344 c------------------------------------------------------------------------------
6345 subroutine multibody(ecorr)
6346 C This subroutine calculates multi-body contributions to energy following
6347 C the idea of Skolnick et al. If side chains I and J make a contact and
6348 C at the same time side chains I+1 and J+1 make a contact, an extra
6349 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6350 implicit real*8 (a-h,o-z)
6351 include 'DIMENSIONS'
6352 include 'COMMON.IOUNITS'
6353 include 'COMMON.DERIV'
6354 include 'COMMON.INTERACT'
6355 include 'COMMON.CONTACTS'
6356 double precision gx(3),gx1(3)
6359 C Set lprn=.true. for debugging
6363 write (iout,'(a)') 'Contact function values:'
6365 write (iout,'(i2,20(1x,i2,f10.5))')
6366 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6381 num_conti=num_cont(i)
6382 num_conti1=num_cont(i1)
6387 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6388 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6389 cd & ' ishift=',ishift
6390 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6391 C The system gains extra energy.
6392 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6393 endif ! j1==j+-ishift
6402 c------------------------------------------------------------------------------
6403 double precision function esccorr(i,j,k,l,jj,kk)
6404 implicit real*8 (a-h,o-z)
6405 include 'DIMENSIONS'
6406 include 'COMMON.IOUNITS'
6407 include 'COMMON.DERIV'
6408 include 'COMMON.INTERACT'
6409 include 'COMMON.CONTACTS'
6410 double precision gx(3),gx1(3)
6415 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6416 C Calculate the multi-body contribution to energy.
6417 C Calculate multi-body contributions to the gradient.
6418 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6419 cd & k,l,(gacont(m,kk,k),m=1,3)
6421 gx(m) =ekl*gacont(m,jj,i)
6422 gx1(m)=eij*gacont(m,kk,k)
6423 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6424 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6425 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6426 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6430 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6435 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6441 c------------------------------------------------------------------------------
6443 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
6444 implicit real*8 (a-h,o-z)
6445 include 'DIMENSIONS'
6446 integer dimen1,dimen2,atom,indx
6447 double precision buffer(dimen1,dimen2)
6448 double precision zapas
6449 common /contacts_hb/ zapas(3,20,maxres,7),
6450 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6451 & num_cont_hb(maxres),jcont_hb(20,maxres)
6452 num_kont=num_cont_hb(atom)
6456 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
6459 buffer(i,indx+22)=facont_hb(i,atom)
6460 buffer(i,indx+23)=ees0p(i,atom)
6461 buffer(i,indx+24)=ees0m(i,atom)
6462 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
6464 buffer(1,indx+26)=dfloat(num_kont)
6467 c------------------------------------------------------------------------------
6468 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
6469 implicit real*8 (a-h,o-z)
6470 include 'DIMENSIONS'
6471 integer dimen1,dimen2,atom,indx
6472 double precision buffer(dimen1,dimen2)
6473 double precision zapas
6474 common /contacts_hb/ zapas(3,20,maxres,7),
6475 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6476 & num_cont_hb(maxres),jcont_hb(20,maxres)
6477 num_kont=buffer(1,indx+26)
6478 num_kont_old=num_cont_hb(atom)
6479 num_cont_hb(atom)=num_kont+num_kont_old
6484 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
6487 facont_hb(ii,atom)=buffer(i,indx+22)
6488 ees0p(ii,atom)=buffer(i,indx+23)
6489 ees0m(ii,atom)=buffer(i,indx+24)
6490 jcont_hb(ii,atom)=buffer(i,indx+25)
6494 c------------------------------------------------------------------------------
6496 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6497 C This subroutine calculates multi-body contributions to hydrogen-bonding
6498 implicit real*8 (a-h,o-z)
6499 include 'DIMENSIONS'
6500 include 'DIMENSIONS.ZSCOPT'
6501 include 'COMMON.IOUNITS'
6503 include 'COMMON.INFO'
6505 include 'COMMON.FFIELD'
6506 include 'COMMON.DERIV'
6507 include 'COMMON.INTERACT'
6508 include 'COMMON.CONTACTS'
6510 parameter (max_cont=maxconts)
6511 parameter (max_dim=2*(8*3+2))
6512 parameter (msglen1=max_cont*max_dim*4)
6513 parameter (msglen2=2*msglen1)
6514 integer source,CorrelType,CorrelID,Error
6515 double precision buffer(max_cont,max_dim)
6517 double precision gx(3),gx1(3)
6520 C Set lprn=.true. for debugging
6525 if (fgProcs.le.1) goto 30
6527 write (iout,'(a)') 'Contact function values:'
6529 write (iout,'(2i3,50(1x,i2,f5.2))')
6530 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6531 & j=1,num_cont_hb(i))
6534 C Caution! Following code assumes that electrostatic interactions concerning
6535 C a given atom are split among at most two processors!
6545 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6548 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6549 if (MyRank.gt.0) then
6550 C Send correlation contributions to the preceding processor
6552 nn=num_cont_hb(iatel_s)
6553 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6554 cd write (iout,*) 'The BUFFER array:'
6556 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6558 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6560 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6561 C Clear the contacts of the atom passed to the neighboring processor
6562 nn=num_cont_hb(iatel_s+1)
6564 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6566 num_cont_hb(iatel_s)=0
6568 cd write (iout,*) 'Processor ',MyID,MyRank,
6569 cd & ' is sending correlation contribution to processor',MyID-1,
6570 cd & ' msglen=',msglen
6571 cd write (*,*) 'Processor ',MyID,MyRank,
6572 cd & ' is sending correlation contribution to processor',MyID-1,
6573 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6574 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6575 cd write (iout,*) 'Processor ',MyID,
6576 cd & ' has sent correlation contribution to processor',MyID-1,
6577 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6578 cd write (*,*) 'Processor ',MyID,
6579 cd & ' has sent correlation contribution to processor',MyID-1,
6580 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6582 endif ! (MyRank.gt.0)
6586 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6587 if (MyRank.lt.fgProcs-1) then
6588 C Receive correlation contributions from the next processor
6590 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6591 cd write (iout,*) 'Processor',MyID,
6592 cd & ' is receiving correlation contribution from processor',MyID+1,
6593 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6594 cd write (*,*) 'Processor',MyID,
6595 cd & ' is receiving correlation contribution from processor',MyID+1,
6596 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6598 do while (nbytes.le.0)
6599 call mp_probe(MyID+1,CorrelType,nbytes)
6601 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6602 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6603 cd write (iout,*) 'Processor',MyID,
6604 cd & ' has received correlation contribution from processor',MyID+1,
6605 cd & ' msglen=',msglen,' nbytes=',nbytes
6606 cd write (iout,*) 'The received BUFFER array:'
6608 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6610 if (msglen.eq.msglen1) then
6611 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6612 else if (msglen.eq.msglen2) then
6613 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6614 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6617 & 'ERROR!!!! message length changed while processing correlations.'
6619 & 'ERROR!!!! message length changed while processing correlations.'
6620 call mp_stopall(Error)
6621 endif ! msglen.eq.msglen1
6622 endif ! MyRank.lt.fgProcs-1
6629 write (iout,'(a)') 'Contact function values:'
6631 write (iout,'(2i3,50(1x,i2,f5.2))')
6632 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6633 & j=1,num_cont_hb(i))
6637 C Remove the loop below after debugging !!!
6644 C Calculate the local-electrostatic correlation terms
6645 do i=iatel_s,iatel_e+1
6647 num_conti=num_cont_hb(i)
6648 num_conti1=num_cont_hb(i+1)
6653 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6654 c & ' jj=',jj,' kk=',kk
6655 if (j1.eq.j+1 .or. j1.eq.j-1) then
6656 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6657 C The system gains extra energy.
6658 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6660 else if (j1.eq.j) then
6661 C Contacts I-J and I-(J+1) occur simultaneously.
6662 C The system loses extra energy.
6663 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6668 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6669 c & ' jj=',jj,' kk=',kk
6671 C Contacts I-J and (I+1)-J occur simultaneously.
6672 C The system loses extra energy.
6673 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6680 c------------------------------------------------------------------------------
6681 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6683 C This subroutine calculates multi-body contributions to hydrogen-bonding
6684 implicit real*8 (a-h,o-z)
6685 include 'DIMENSIONS'
6686 include 'DIMENSIONS.ZSCOPT'
6687 include 'COMMON.IOUNITS'
6689 include 'COMMON.INFO'
6691 include 'COMMON.FFIELD'
6692 include 'COMMON.DERIV'
6693 include 'COMMON.INTERACT'
6694 include 'COMMON.CONTACTS'
6696 parameter (max_cont=maxconts)
6697 parameter (max_dim=2*(8*3+2))
6698 parameter (msglen1=max_cont*max_dim*4)
6699 parameter (msglen2=2*msglen1)
6700 integer source,CorrelType,CorrelID,Error
6701 double precision buffer(max_cont,max_dim)
6703 double precision gx(3),gx1(3)
6706 C Set lprn=.true. for debugging
6712 if (fgProcs.le.1) goto 30
6714 write (iout,'(a)') 'Contact function values:'
6716 write (iout,'(2i3,50(1x,i2,f5.2))')
6717 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6718 & j=1,num_cont_hb(i))
6721 C Caution! Following code assumes that electrostatic interactions concerning
6722 C a given atom are split among at most two processors!
6732 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6735 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6736 if (MyRank.gt.0) then
6737 C Send correlation contributions to the preceding processor
6739 nn=num_cont_hb(iatel_s)
6740 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6741 cd write (iout,*) 'The BUFFER array:'
6743 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6745 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6747 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6748 C Clear the contacts of the atom passed to the neighboring processor
6749 nn=num_cont_hb(iatel_s+1)
6751 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6753 num_cont_hb(iatel_s)=0
6755 cd write (iout,*) 'Processor ',MyID,MyRank,
6756 cd & ' is sending correlation contribution to processor',MyID-1,
6757 cd & ' msglen=',msglen
6758 cd write (*,*) 'Processor ',MyID,MyRank,
6759 cd & ' is sending correlation contribution to processor',MyID-1,
6760 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6761 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6762 cd write (iout,*) 'Processor ',MyID,
6763 cd & ' has sent correlation contribution to processor',MyID-1,
6764 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6765 cd write (*,*) 'Processor ',MyID,
6766 cd & ' has sent correlation contribution to processor',MyID-1,
6767 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6769 endif ! (MyRank.gt.0)
6773 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6774 if (MyRank.lt.fgProcs-1) then
6775 C Receive correlation contributions from the next processor
6777 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6778 cd write (iout,*) 'Processor',MyID,
6779 cd & ' is receiving correlation contribution from processor',MyID+1,
6780 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6781 cd write (*,*) 'Processor',MyID,
6782 cd & ' is receiving correlation contribution from processor',MyID+1,
6783 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6785 do while (nbytes.le.0)
6786 call mp_probe(MyID+1,CorrelType,nbytes)
6788 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6789 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6790 cd write (iout,*) 'Processor',MyID,
6791 cd & ' has received correlation contribution from processor',MyID+1,
6792 cd & ' msglen=',msglen,' nbytes=',nbytes
6793 cd write (iout,*) 'The received BUFFER array:'
6795 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6797 if (msglen.eq.msglen1) then
6798 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6799 else if (msglen.eq.msglen2) then
6800 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6801 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6804 & 'ERROR!!!! message length changed while processing correlations.'
6806 & 'ERROR!!!! message length changed while processing correlations.'
6807 call mp_stopall(Error)
6808 endif ! msglen.eq.msglen1
6809 endif ! MyRank.lt.fgProcs-1
6816 write (iout,'(a)') 'Contact function values:'
6818 write (iout,'(2i3,50(1x,i2,f5.2))')
6819 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6820 & j=1,num_cont_hb(i))
6826 C Remove the loop below after debugging !!!
6833 C Calculate the dipole-dipole interaction energies
6834 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6835 do i=iatel_s,iatel_e+1
6836 num_conti=num_cont_hb(i)
6843 C Calculate the local-electrostatic correlation terms
6844 do i=iatel_s,iatel_e+1
6846 num_conti=num_cont_hb(i)
6847 num_conti1=num_cont_hb(i+1)
6852 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6853 c & ' jj=',jj,' kk=',kk
6854 if (j1.eq.j+1 .or. j1.eq.j-1) then
6855 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6856 C The system gains extra energy.
6858 sqd1=dsqrt(d_cont(jj,i))
6859 sqd2=dsqrt(d_cont(kk,i1))
6860 sred_geom = sqd1*sqd2
6861 IF (sred_geom.lt.cutoff_corr) THEN
6862 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6864 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6865 c & ' jj=',jj,' kk=',kk
6866 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6867 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6869 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6870 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6873 cd write (iout,*) 'sred_geom=',sred_geom,
6874 cd & ' ekont=',ekont,' fprim=',fprimcont
6875 call calc_eello(i,j,i+1,j1,jj,kk)
6876 if (wcorr4.gt.0.0d0)
6877 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6878 if (wcorr5.gt.0.0d0)
6879 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6880 c print *,"wcorr5",ecorr5
6881 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6882 cd write(2,*)'ijkl',i,j,i+1,j1
6883 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6884 & .or. wturn6.eq.0.0d0))then
6885 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6886 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6887 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6888 cd & 'ecorr6=',ecorr6
6889 cd write (iout,'(4e15.5)') sred_geom,
6890 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6891 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6892 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6893 else if (wturn6.gt.0.0d0
6894 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6895 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6896 eturn6=eturn6+eello_turn6(i,jj,kk)
6897 cd write (2,*) 'multibody_eello:eturn6',eturn6
6901 else if (j1.eq.j) then
6902 C Contacts I-J and I-(J+1) occur simultaneously.
6903 C The system loses extra energy.
6904 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6909 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6910 c & ' jj=',jj,' kk=',kk
6912 C Contacts I-J and (I+1)-J occur simultaneously.
6913 C The system loses extra energy.
6914 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6921 c------------------------------------------------------------------------------
6922 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6923 implicit real*8 (a-h,o-z)
6924 include 'DIMENSIONS'
6925 include 'COMMON.IOUNITS'
6926 include 'COMMON.DERIV'
6927 include 'COMMON.INTERACT'
6928 include 'COMMON.CONTACTS'
6929 double precision gx(3),gx1(3)
6939 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6940 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6941 C Following 4 lines for diagnostics.
6946 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6948 c write (iout,*)'Contacts have occurred for peptide groups',
6949 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6950 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6951 C Calculate the multi-body contribution to energy.
6952 ecorr=ecorr+ekont*ees
6954 C Calculate multi-body contributions to the gradient.
6956 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6957 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6958 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6959 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6960 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6961 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6962 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6963 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6964 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6965 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6966 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6967 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6968 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6969 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6973 gradcorr(ll,m)=gradcorr(ll,m)+
6974 & ees*ekl*gacont_hbr(ll,jj,i)-
6975 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6976 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6981 gradcorr(ll,m)=gradcorr(ll,m)+
6982 & ees*eij*gacont_hbr(ll,kk,k)-
6983 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6984 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6991 C---------------------------------------------------------------------------
6992 subroutine dipole(i,j,jj)
6993 implicit real*8 (a-h,o-z)
6994 include 'DIMENSIONS'
6995 include 'DIMENSIONS.ZSCOPT'
6996 include 'COMMON.IOUNITS'
6997 include 'COMMON.CHAIN'
6998 include 'COMMON.FFIELD'
6999 include 'COMMON.DERIV'
7000 include 'COMMON.INTERACT'
7001 include 'COMMON.CONTACTS'
7002 include 'COMMON.TORSION'
7003 include 'COMMON.VAR'
7004 include 'COMMON.GEO'
7005 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7007 iti1 = itortyp(itype(i+1))
7008 if (j.lt.nres-1) then
7009 itj1 = itortyp(itype(j+1))
7014 dipi(iii,1)=Ub2(iii,i)
7015 dipderi(iii)=Ub2der(iii,i)
7016 dipi(iii,2)=b1(iii,iti1)
7017 dipj(iii,1)=Ub2(iii,j)
7018 dipderj(iii)=Ub2der(iii,j)
7019 dipj(iii,2)=b1(iii,itj1)
7023 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7026 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7029 if (.not.calc_grad) return
7034 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7038 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7043 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7044 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7046 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7048 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7050 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7054 C---------------------------------------------------------------------------
7055 subroutine calc_eello(i,j,k,l,jj,kk)
7057 C This subroutine computes matrices and vectors needed to calculate
7058 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7060 implicit real*8 (a-h,o-z)
7061 include 'DIMENSIONS'
7062 include 'DIMENSIONS.ZSCOPT'
7063 include 'COMMON.IOUNITS'
7064 include 'COMMON.CHAIN'
7065 include 'COMMON.DERIV'
7066 include 'COMMON.INTERACT'
7067 include 'COMMON.CONTACTS'
7068 include 'COMMON.TORSION'
7069 include 'COMMON.VAR'
7070 include 'COMMON.GEO'
7071 include 'COMMON.FFIELD'
7072 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7073 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7076 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7077 cd & ' jj=',jj,' kk=',kk
7078 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7081 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7082 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7085 call transpose2(aa1(1,1),aa1t(1,1))
7086 call transpose2(aa2(1,1),aa2t(1,1))
7089 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7090 & aa1tder(1,1,lll,kkk))
7091 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7092 & aa2tder(1,1,lll,kkk))
7096 C parallel orientation of the two CA-CA-CA frames.
7098 iti=itortyp(itype(i))
7102 itk1=itortyp(itype(k+1))
7103 itj=itortyp(itype(j))
7104 if (l.lt.nres-1) then
7105 itl1=itortyp(itype(l+1))
7109 C A1 kernel(j+1) A2T
7111 cd write (iout,'(3f10.5,5x,3f10.5)')
7112 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7114 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7115 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7116 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7117 C Following matrices are needed only for 6-th order cumulants
7118 IF (wcorr6.gt.0.0d0) THEN
7119 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7120 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7121 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7122 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7123 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7124 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7125 & ADtEAderx(1,1,1,1,1,1))
7127 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7128 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7129 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7130 & ADtEA1derx(1,1,1,1,1,1))
7132 C End 6-th order cumulants
7135 cd write (2,*) 'In calc_eello6'
7137 cd write (2,*) 'iii=',iii
7139 cd write (2,*) 'kkk=',kkk
7141 cd write (2,'(3(2f10.5),5x)')
7142 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7147 call transpose2(EUgder(1,1,k),auxmat(1,1))
7148 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7149 call transpose2(EUg(1,1,k),auxmat(1,1))
7150 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7151 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7155 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7156 & EAEAderx(1,1,lll,kkk,iii,1))
7160 C A1T kernel(i+1) A2
7161 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7162 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7163 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7164 C Following matrices are needed only for 6-th order cumulants
7165 IF (wcorr6.gt.0.0d0) THEN
7166 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7167 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7168 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7169 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7170 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7171 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7172 & ADtEAderx(1,1,1,1,1,2))
7173 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7174 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7175 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7176 & ADtEA1derx(1,1,1,1,1,2))
7178 C End 6-th order cumulants
7179 call transpose2(EUgder(1,1,l),auxmat(1,1))
7180 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7181 call transpose2(EUg(1,1,l),auxmat(1,1))
7182 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7183 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7187 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7188 & EAEAderx(1,1,lll,kkk,iii,2))
7193 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7194 C They are needed only when the fifth- or the sixth-order cumulants are
7196 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7197 call transpose2(AEA(1,1,1),auxmat(1,1))
7198 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7199 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7200 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7201 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7202 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7203 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7204 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7205 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7206 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7207 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7208 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7209 call transpose2(AEA(1,1,2),auxmat(1,1))
7210 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7211 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7212 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7213 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7214 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7215 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7216 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7217 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7218 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7219 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7220 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7221 C Calculate the Cartesian derivatives of the vectors.
7225 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7226 call matvec2(auxmat(1,1),b1(1,iti),
7227 & AEAb1derx(1,lll,kkk,iii,1,1))
7228 call matvec2(auxmat(1,1),Ub2(1,i),
7229 & AEAb2derx(1,lll,kkk,iii,1,1))
7230 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7231 & AEAb1derx(1,lll,kkk,iii,2,1))
7232 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7233 & AEAb2derx(1,lll,kkk,iii,2,1))
7234 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7235 call matvec2(auxmat(1,1),b1(1,itj),
7236 & AEAb1derx(1,lll,kkk,iii,1,2))
7237 call matvec2(auxmat(1,1),Ub2(1,j),
7238 & AEAb2derx(1,lll,kkk,iii,1,2))
7239 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7240 & AEAb1derx(1,lll,kkk,iii,2,2))
7241 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7242 & AEAb2derx(1,lll,kkk,iii,2,2))
7249 C Antiparallel orientation of the two CA-CA-CA frames.
7251 iti=itortyp(itype(i))
7255 itk1=itortyp(itype(k+1))
7256 itl=itortyp(itype(l))
7257 itj=itortyp(itype(j))
7258 if (j.lt.nres-1) then
7259 itj1=itortyp(itype(j+1))
7263 C A2 kernel(j-1)T A1T
7264 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7265 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7266 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7267 C Following matrices are needed only for 6-th order cumulants
7268 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7269 & j.eq.i+4 .and. l.eq.i+3)) THEN
7270 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7271 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7272 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7273 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7274 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7275 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7276 & ADtEAderx(1,1,1,1,1,1))
7277 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7278 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7279 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7280 & ADtEA1derx(1,1,1,1,1,1))
7282 C End 6-th order cumulants
7283 call transpose2(EUgder(1,1,k),auxmat(1,1))
7284 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7285 call transpose2(EUg(1,1,k),auxmat(1,1))
7286 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7287 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7291 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7292 & EAEAderx(1,1,lll,kkk,iii,1))
7296 C A2T kernel(i+1)T A1
7297 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7298 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7299 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7300 C Following matrices are needed only for 6-th order cumulants
7301 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7302 & j.eq.i+4 .and. l.eq.i+3)) THEN
7303 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7304 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7305 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7306 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7307 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7308 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7309 & ADtEAderx(1,1,1,1,1,2))
7310 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7311 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7312 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7313 & ADtEA1derx(1,1,1,1,1,2))
7315 C End 6-th order cumulants
7316 call transpose2(EUgder(1,1,j),auxmat(1,1))
7317 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7318 call transpose2(EUg(1,1,j),auxmat(1,1))
7319 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7320 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7324 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7325 & EAEAderx(1,1,lll,kkk,iii,2))
7330 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7331 C They are needed only when the fifth- or the sixth-order cumulants are
7333 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7334 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7335 call transpose2(AEA(1,1,1),auxmat(1,1))
7336 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7337 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7338 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7339 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7340 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7341 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7342 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7343 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7344 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7345 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7346 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7347 call transpose2(AEA(1,1,2),auxmat(1,1))
7348 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7349 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7350 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7351 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7352 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7353 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7354 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7355 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7356 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7357 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7358 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7359 C Calculate the Cartesian derivatives of the vectors.
7363 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7364 call matvec2(auxmat(1,1),b1(1,iti),
7365 & AEAb1derx(1,lll,kkk,iii,1,1))
7366 call matvec2(auxmat(1,1),Ub2(1,i),
7367 & AEAb2derx(1,lll,kkk,iii,1,1))
7368 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7369 & AEAb1derx(1,lll,kkk,iii,2,1))
7370 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7371 & AEAb2derx(1,lll,kkk,iii,2,1))
7372 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7373 call matvec2(auxmat(1,1),b1(1,itl),
7374 & AEAb1derx(1,lll,kkk,iii,1,2))
7375 call matvec2(auxmat(1,1),Ub2(1,l),
7376 & AEAb2derx(1,lll,kkk,iii,1,2))
7377 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7378 & AEAb1derx(1,lll,kkk,iii,2,2))
7379 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7380 & AEAb2derx(1,lll,kkk,iii,2,2))
7389 C---------------------------------------------------------------------------
7390 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7391 & KK,KKderg,AKA,AKAderg,AKAderx)
7395 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7396 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7397 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7402 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7404 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7407 cd if (lprn) write (2,*) 'In kernel'
7409 cd if (lprn) write (2,*) 'kkk=',kkk
7411 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7412 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7414 cd write (2,*) 'lll=',lll
7415 cd write (2,*) 'iii=1'
7417 cd write (2,'(3(2f10.5),5x)')
7418 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7421 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7422 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7424 cd write (2,*) 'lll=',lll
7425 cd write (2,*) 'iii=2'
7427 cd write (2,'(3(2f10.5),5x)')
7428 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7435 C---------------------------------------------------------------------------
7436 double precision function eello4(i,j,k,l,jj,kk)
7437 implicit real*8 (a-h,o-z)
7438 include 'DIMENSIONS'
7439 include 'DIMENSIONS.ZSCOPT'
7440 include 'COMMON.IOUNITS'
7441 include 'COMMON.CHAIN'
7442 include 'COMMON.DERIV'
7443 include 'COMMON.INTERACT'
7444 include 'COMMON.CONTACTS'
7445 include 'COMMON.TORSION'
7446 include 'COMMON.VAR'
7447 include 'COMMON.GEO'
7448 double precision pizda(2,2),ggg1(3),ggg2(3)
7449 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7453 cd print *,'eello4:',i,j,k,l,jj,kk
7454 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7455 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7456 cold eij=facont_hb(jj,i)
7457 cold ekl=facont_hb(kk,k)
7459 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7461 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7462 gcorr_loc(k-1)=gcorr_loc(k-1)
7463 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7465 gcorr_loc(l-1)=gcorr_loc(l-1)
7466 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7468 gcorr_loc(j-1)=gcorr_loc(j-1)
7469 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7474 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7475 & -EAEAderx(2,2,lll,kkk,iii,1)
7476 cd derx(lll,kkk,iii)=0.0d0
7480 cd gcorr_loc(l-1)=0.0d0
7481 cd gcorr_loc(j-1)=0.0d0
7482 cd gcorr_loc(k-1)=0.0d0
7484 cd write (iout,*)'Contacts have occurred for peptide groups',
7485 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7486 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7487 if (j.lt.nres-1) then
7494 if (l.lt.nres-1) then
7502 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
7503 ggg1(ll)=eel4*g_contij(ll,1)
7504 ggg2(ll)=eel4*g_contij(ll,2)
7505 ghalf=0.5d0*ggg1(ll)
7507 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
7508 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7509 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
7510 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7511 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
7512 ghalf=0.5d0*ggg2(ll)
7514 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
7515 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7516 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
7517 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7522 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
7523 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7528 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
7529 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7535 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7540 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7544 cd write (2,*) iii,gcorr_loc(iii)
7548 cd write (2,*) 'ekont',ekont
7549 cd write (iout,*) 'eello4',ekont*eel4
7552 C---------------------------------------------------------------------------
7553 double precision function eello5(i,j,k,l,jj,kk)
7554 implicit real*8 (a-h,o-z)
7555 include 'DIMENSIONS'
7556 include 'DIMENSIONS.ZSCOPT'
7557 include 'COMMON.IOUNITS'
7558 include 'COMMON.CHAIN'
7559 include 'COMMON.DERIV'
7560 include 'COMMON.INTERACT'
7561 include 'COMMON.CONTACTS'
7562 include 'COMMON.TORSION'
7563 include 'COMMON.VAR'
7564 include 'COMMON.GEO'
7565 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7566 double precision ggg1(3),ggg2(3)
7567 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7572 C /l\ / \ \ / \ / \ / C
7573 C / \ / \ \ / \ / \ / C
7574 C j| o |l1 | o | o| o | | o |o C
7575 C \ |/k\| |/ \| / |/ \| |/ \| C
7576 C \i/ \ / \ / / \ / \ C
7578 C (I) (II) (III) (IV) C
7580 C eello5_1 eello5_2 eello5_3 eello5_4 C
7582 C Antiparallel chains C
7585 C /j\ / \ \ / \ / \ / C
7586 C / \ / \ \ / \ / \ / C
7587 C j1| o |l | o | o| o | | o |o C
7588 C \ |/k\| |/ \| / |/ \| |/ \| C
7589 C \i/ \ / \ / / \ / \ C
7591 C (I) (II) (III) (IV) C
7593 C eello5_1 eello5_2 eello5_3 eello5_4 C
7595 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7597 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7598 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7603 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7605 itk=itortyp(itype(k))
7606 itl=itortyp(itype(l))
7607 itj=itortyp(itype(j))
7612 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7613 cd & eel5_3_num,eel5_4_num)
7617 derx(lll,kkk,iii)=0.0d0
7621 cd eij=facont_hb(jj,i)
7622 cd ekl=facont_hb(kk,k)
7624 cd write (iout,*)'Contacts have occurred for peptide groups',
7625 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7627 C Contribution from the graph I.
7628 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7629 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7630 call transpose2(EUg(1,1,k),auxmat(1,1))
7631 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7632 vv(1)=pizda(1,1)-pizda(2,2)
7633 vv(2)=pizda(1,2)+pizda(2,1)
7634 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7635 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7637 C Explicit gradient in virtual-dihedral angles.
7638 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7639 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7640 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7641 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7642 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7643 vv(1)=pizda(1,1)-pizda(2,2)
7644 vv(2)=pizda(1,2)+pizda(2,1)
7645 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7646 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7647 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7648 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7649 vv(1)=pizda(1,1)-pizda(2,2)
7650 vv(2)=pizda(1,2)+pizda(2,1)
7652 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7653 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7654 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7656 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7657 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7658 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7660 C Cartesian gradient
7664 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7666 vv(1)=pizda(1,1)-pizda(2,2)
7667 vv(2)=pizda(1,2)+pizda(2,1)
7668 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7669 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7670 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7677 C Contribution from graph II
7678 call transpose2(EE(1,1,itk),auxmat(1,1))
7679 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7680 vv(1)=pizda(1,1)+pizda(2,2)
7681 vv(2)=pizda(2,1)-pizda(1,2)
7682 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7683 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7685 C Explicit gradient in virtual-dihedral angles.
7686 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7687 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7688 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7689 vv(1)=pizda(1,1)+pizda(2,2)
7690 vv(2)=pizda(2,1)-pizda(1,2)
7692 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7693 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7694 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7696 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7697 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7698 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7700 C Cartesian gradient
7704 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7706 vv(1)=pizda(1,1)+pizda(2,2)
7707 vv(2)=pizda(2,1)-pizda(1,2)
7708 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7709 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7710 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7719 C Parallel orientation
7720 C Contribution from graph III
7721 call transpose2(EUg(1,1,l),auxmat(1,1))
7722 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7723 vv(1)=pizda(1,1)-pizda(2,2)
7724 vv(2)=pizda(1,2)+pizda(2,1)
7725 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7726 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7728 C Explicit gradient in virtual-dihedral angles.
7729 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7730 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7731 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7732 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7733 vv(1)=pizda(1,1)-pizda(2,2)
7734 vv(2)=pizda(1,2)+pizda(2,1)
7735 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7736 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7737 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7738 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7739 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7740 vv(1)=pizda(1,1)-pizda(2,2)
7741 vv(2)=pizda(1,2)+pizda(2,1)
7742 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7743 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7744 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7745 C Cartesian gradient
7749 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7751 vv(1)=pizda(1,1)-pizda(2,2)
7752 vv(2)=pizda(1,2)+pizda(2,1)
7753 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7754 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7755 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7761 C Contribution from graph IV
7763 call transpose2(EE(1,1,itl),auxmat(1,1))
7764 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7765 vv(1)=pizda(1,1)+pizda(2,2)
7766 vv(2)=pizda(2,1)-pizda(1,2)
7767 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7768 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7770 C Explicit gradient in virtual-dihedral angles.
7771 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7772 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7773 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7774 vv(1)=pizda(1,1)+pizda(2,2)
7775 vv(2)=pizda(2,1)-pizda(1,2)
7776 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7777 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7778 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7779 C Cartesian gradient
7783 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7785 vv(1)=pizda(1,1)+pizda(2,2)
7786 vv(2)=pizda(2,1)-pizda(1,2)
7787 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7788 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7789 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7795 C Antiparallel orientation
7796 C Contribution from graph III
7798 call transpose2(EUg(1,1,j),auxmat(1,1))
7799 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7800 vv(1)=pizda(1,1)-pizda(2,2)
7801 vv(2)=pizda(1,2)+pizda(2,1)
7802 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7803 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7805 C Explicit gradient in virtual-dihedral angles.
7806 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7807 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7808 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7809 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7810 vv(1)=pizda(1,1)-pizda(2,2)
7811 vv(2)=pizda(1,2)+pizda(2,1)
7812 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7813 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7814 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7815 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7816 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7817 vv(1)=pizda(1,1)-pizda(2,2)
7818 vv(2)=pizda(1,2)+pizda(2,1)
7819 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7820 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7821 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7822 C Cartesian gradient
7826 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7828 vv(1)=pizda(1,1)-pizda(2,2)
7829 vv(2)=pizda(1,2)+pizda(2,1)
7830 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7831 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7832 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7838 C Contribution from graph IV
7840 call transpose2(EE(1,1,itj),auxmat(1,1))
7841 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7842 vv(1)=pizda(1,1)+pizda(2,2)
7843 vv(2)=pizda(2,1)-pizda(1,2)
7844 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7845 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7847 C Explicit gradient in virtual-dihedral angles.
7848 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7849 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7850 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7851 vv(1)=pizda(1,1)+pizda(2,2)
7852 vv(2)=pizda(2,1)-pizda(1,2)
7853 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7854 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7855 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7856 C Cartesian gradient
7860 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7862 vv(1)=pizda(1,1)+pizda(2,2)
7863 vv(2)=pizda(2,1)-pizda(1,2)
7864 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7865 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7866 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7873 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7874 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7875 cd write (2,*) 'ijkl',i,j,k,l
7876 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7877 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7879 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7880 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7881 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7882 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7884 if (j.lt.nres-1) then
7891 if (l.lt.nres-1) then
7901 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7903 ggg1(ll)=eel5*g_contij(ll,1)
7904 ggg2(ll)=eel5*g_contij(ll,2)
7905 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7906 ghalf=0.5d0*ggg1(ll)
7908 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7909 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7910 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7911 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7912 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7913 ghalf=0.5d0*ggg2(ll)
7915 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7916 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7917 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7918 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7923 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7924 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7929 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7930 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7936 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7941 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7945 cd write (2,*) iii,g_corr5_loc(iii)
7949 cd write (2,*) 'ekont',ekont
7950 cd write (iout,*) 'eello5',ekont*eel5
7953 c--------------------------------------------------------------------------
7954 double precision function eello6(i,j,k,l,jj,kk)
7955 implicit real*8 (a-h,o-z)
7956 include 'DIMENSIONS'
7957 include 'DIMENSIONS.ZSCOPT'
7958 include 'COMMON.IOUNITS'
7959 include 'COMMON.CHAIN'
7960 include 'COMMON.DERIV'
7961 include 'COMMON.INTERACT'
7962 include 'COMMON.CONTACTS'
7963 include 'COMMON.TORSION'
7964 include 'COMMON.VAR'
7965 include 'COMMON.GEO'
7966 include 'COMMON.FFIELD'
7967 double precision ggg1(3),ggg2(3)
7968 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7973 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7981 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7982 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7986 derx(lll,kkk,iii)=0.0d0
7990 cd eij=facont_hb(jj,i)
7991 cd ekl=facont_hb(kk,k)
7997 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7998 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7999 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8000 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8001 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8002 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8004 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8005 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8006 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8007 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8008 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8009 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8013 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8015 C If turn contributions are considered, they will be handled separately.
8016 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8017 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
8018 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
8019 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
8020 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
8021 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
8022 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
8025 if (j.lt.nres-1) then
8032 if (l.lt.nres-1) then
8040 ggg1(ll)=eel6*g_contij(ll,1)
8041 ggg2(ll)=eel6*g_contij(ll,2)
8042 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8043 ghalf=0.5d0*ggg1(ll)
8045 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
8046 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8047 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
8048 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8049 ghalf=0.5d0*ggg2(ll)
8050 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8052 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
8053 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8054 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
8055 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8060 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8061 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8066 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8067 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8073 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8078 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8082 cd write (2,*) iii,g_corr6_loc(iii)
8086 cd write (2,*) 'ekont',ekont
8087 cd write (iout,*) 'eello6',ekont*eel6
8090 c--------------------------------------------------------------------------
8091 double precision function eello6_graph1(i,j,k,l,imat,swap)
8092 implicit real*8 (a-h,o-z)
8093 include 'DIMENSIONS'
8094 include 'DIMENSIONS.ZSCOPT'
8095 include 'COMMON.IOUNITS'
8096 include 'COMMON.CHAIN'
8097 include 'COMMON.DERIV'
8098 include 'COMMON.INTERACT'
8099 include 'COMMON.CONTACTS'
8100 include 'COMMON.TORSION'
8101 include 'COMMON.VAR'
8102 include 'COMMON.GEO'
8103 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8107 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8109 C Parallel Antiparallel C
8115 C \ j|/k\| / \ |/k\|l / C
8120 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8121 itk=itortyp(itype(k))
8122 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8123 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8124 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8125 call transpose2(EUgC(1,1,k),auxmat(1,1))
8126 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8127 vv1(1)=pizda1(1,1)-pizda1(2,2)
8128 vv1(2)=pizda1(1,2)+pizda1(2,1)
8129 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8130 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8131 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8132 s5=scalar2(vv(1),Dtobr2(1,i))
8133 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8134 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8135 if (.not. calc_grad) return
8136 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8137 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8138 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8139 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8140 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8141 & +scalar2(vv(1),Dtobr2der(1,i)))
8142 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8143 vv1(1)=pizda1(1,1)-pizda1(2,2)
8144 vv1(2)=pizda1(1,2)+pizda1(2,1)
8145 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8146 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8148 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8149 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8150 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8151 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8152 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8154 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8155 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8156 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8157 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8158 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8160 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8161 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8162 vv1(1)=pizda1(1,1)-pizda1(2,2)
8163 vv1(2)=pizda1(1,2)+pizda1(2,1)
8164 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8165 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8166 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8167 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8176 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8177 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8178 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8179 call transpose2(EUgC(1,1,k),auxmat(1,1))
8180 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8182 vv1(1)=pizda1(1,1)-pizda1(2,2)
8183 vv1(2)=pizda1(1,2)+pizda1(2,1)
8184 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8185 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8186 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8187 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8188 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8189 s5=scalar2(vv(1),Dtobr2(1,i))
8190 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8196 c----------------------------------------------------------------------------
8197 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8198 implicit real*8 (a-h,o-z)
8199 include 'DIMENSIONS'
8200 include 'DIMENSIONS.ZSCOPT'
8201 include 'COMMON.IOUNITS'
8202 include 'COMMON.CHAIN'
8203 include 'COMMON.DERIV'
8204 include 'COMMON.INTERACT'
8205 include 'COMMON.CONTACTS'
8206 include 'COMMON.TORSION'
8207 include 'COMMON.VAR'
8208 include 'COMMON.GEO'
8210 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8211 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8214 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8216 C Parallel Antiparallel C
8222 C \ j|/k\| \ |/k\|l C
8227 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8228 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8229 C AL 7/4/01 s1 would occur in the sixth-order moment,
8230 C but not in a cluster cumulant
8232 s1=dip(1,jj,i)*dip(1,kk,k)
8234 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8235 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8236 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8237 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8238 call transpose2(EUg(1,1,k),auxmat(1,1))
8239 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8240 vv(1)=pizda(1,1)-pizda(2,2)
8241 vv(2)=pizda(1,2)+pizda(2,1)
8242 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8243 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8245 eello6_graph2=-(s1+s2+s3+s4)
8247 eello6_graph2=-(s2+s3+s4)
8250 if (.not. calc_grad) return
8251 C Derivatives in gamma(i-1)
8254 s1=dipderg(1,jj,i)*dip(1,kk,k)
8256 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8257 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8258 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8259 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8261 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8263 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8265 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8267 C Derivatives in gamma(k-1)
8269 s1=dip(1,jj,i)*dipderg(1,kk,k)
8271 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8272 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8273 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8274 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8275 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8276 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8277 vv(1)=pizda(1,1)-pizda(2,2)
8278 vv(2)=pizda(1,2)+pizda(2,1)
8279 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8281 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8283 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8285 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8286 C Derivatives in gamma(j-1) or gamma(l-1)
8289 s1=dipderg(3,jj,i)*dip(1,kk,k)
8291 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8292 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8293 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8294 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8295 vv(1)=pizda(1,1)-pizda(2,2)
8296 vv(2)=pizda(1,2)+pizda(2,1)
8297 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8300 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8302 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8305 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8306 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8308 C Derivatives in gamma(l-1) or gamma(j-1)
8311 s1=dip(1,jj,i)*dipderg(3,kk,k)
8313 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8314 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8315 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8316 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8317 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8318 vv(1)=pizda(1,1)-pizda(2,2)
8319 vv(2)=pizda(1,2)+pizda(2,1)
8320 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8323 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8325 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8328 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8329 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8331 C Cartesian derivatives.
8333 write (2,*) 'In eello6_graph2'
8335 write (2,*) 'iii=',iii
8337 write (2,*) 'kkk=',kkk
8339 write (2,'(3(2f10.5),5x)')
8340 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8350 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8352 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8355 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8357 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8358 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8360 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8361 call transpose2(EUg(1,1,k),auxmat(1,1))
8362 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8364 vv(1)=pizda(1,1)-pizda(2,2)
8365 vv(2)=pizda(1,2)+pizda(2,1)
8366 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8367 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8369 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8371 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8374 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8376 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8383 c----------------------------------------------------------------------------
8384 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8385 implicit real*8 (a-h,o-z)
8386 include 'DIMENSIONS'
8387 include 'DIMENSIONS.ZSCOPT'
8388 include 'COMMON.IOUNITS'
8389 include 'COMMON.CHAIN'
8390 include 'COMMON.DERIV'
8391 include 'COMMON.INTERACT'
8392 include 'COMMON.CONTACTS'
8393 include 'COMMON.TORSION'
8394 include 'COMMON.VAR'
8395 include 'COMMON.GEO'
8396 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8398 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8400 C Parallel Antiparallel C
8406 C j|/k\| / |/k\|l / C
8411 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8413 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8414 C energy moment and not to the cluster cumulant.
8415 iti=itortyp(itype(i))
8416 if (j.lt.nres-1) then
8417 itj1=itortyp(itype(j+1))
8421 itk=itortyp(itype(k))
8422 itk1=itortyp(itype(k+1))
8423 if (l.lt.nres-1) then
8424 itl1=itortyp(itype(l+1))
8429 s1=dip(4,jj,i)*dip(4,kk,k)
8431 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8432 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8433 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8434 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8435 call transpose2(EE(1,1,itk),auxmat(1,1))
8436 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8437 vv(1)=pizda(1,1)+pizda(2,2)
8438 vv(2)=pizda(2,1)-pizda(1,2)
8439 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8440 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8442 eello6_graph3=-(s1+s2+s3+s4)
8444 eello6_graph3=-(s2+s3+s4)
8447 if (.not. calc_grad) return
8448 C Derivatives in gamma(k-1)
8449 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8450 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8451 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8452 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8453 C Derivatives in gamma(l-1)
8454 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8455 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8456 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8457 vv(1)=pizda(1,1)+pizda(2,2)
8458 vv(2)=pizda(2,1)-pizda(1,2)
8459 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8460 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8461 C Cartesian derivatives.
8467 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8469 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8472 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8474 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8475 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8477 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8478 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8480 vv(1)=pizda(1,1)+pizda(2,2)
8481 vv(2)=pizda(2,1)-pizda(1,2)
8482 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8484 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8486 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8489 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8491 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8493 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8499 c----------------------------------------------------------------------------
8500 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8501 implicit real*8 (a-h,o-z)
8502 include 'DIMENSIONS'
8503 include 'DIMENSIONS.ZSCOPT'
8504 include 'COMMON.IOUNITS'
8505 include 'COMMON.CHAIN'
8506 include 'COMMON.DERIV'
8507 include 'COMMON.INTERACT'
8508 include 'COMMON.CONTACTS'
8509 include 'COMMON.TORSION'
8510 include 'COMMON.VAR'
8511 include 'COMMON.GEO'
8512 include 'COMMON.FFIELD'
8513 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8514 & auxvec1(2),auxmat1(2,2)
8516 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8518 C Parallel Antiparallel C
8524 C \ j|/k\| \ |/k\|l C
8529 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8531 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8532 C energy moment and not to the cluster cumulant.
8533 cd write (2,*) 'eello_graph4: wturn6',wturn6
8534 iti=itortyp(itype(i))
8535 itj=itortyp(itype(j))
8536 if (j.lt.nres-1) then
8537 itj1=itortyp(itype(j+1))
8541 itk=itortyp(itype(k))
8542 if (k.lt.nres-1) then
8543 itk1=itortyp(itype(k+1))
8547 itl=itortyp(itype(l))
8548 if (l.lt.nres-1) then
8549 itl1=itortyp(itype(l+1))
8553 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8554 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8555 cd & ' itl',itl,' itl1',itl1
8558 s1=dip(3,jj,i)*dip(3,kk,k)
8560 s1=dip(2,jj,j)*dip(2,kk,l)
8563 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8564 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8566 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8567 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8569 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8570 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8572 call transpose2(EUg(1,1,k),auxmat(1,1))
8573 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8574 vv(1)=pizda(1,1)-pizda(2,2)
8575 vv(2)=pizda(2,1)+pizda(1,2)
8576 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8577 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8579 eello6_graph4=-(s1+s2+s3+s4)
8581 eello6_graph4=-(s2+s3+s4)
8583 if (.not. calc_grad) return
8584 C Derivatives in gamma(i-1)
8588 s1=dipderg(2,jj,i)*dip(3,kk,k)
8590 s1=dipderg(4,jj,j)*dip(2,kk,l)
8593 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8595 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8596 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8598 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8599 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8601 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8602 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8603 cd write (2,*) 'turn6 derivatives'
8605 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8607 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8611 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8613 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8617 C Derivatives in gamma(k-1)
8620 s1=dip(3,jj,i)*dipderg(2,kk,k)
8622 s1=dip(2,jj,j)*dipderg(4,kk,l)
8625 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8626 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8628 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8629 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8631 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8632 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8634 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8635 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8636 vv(1)=pizda(1,1)-pizda(2,2)
8637 vv(2)=pizda(2,1)+pizda(1,2)
8638 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8639 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8641 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8643 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8647 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8649 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8652 C Derivatives in gamma(j-1) or gamma(l-1)
8653 if (l.eq.j+1 .and. l.gt.1) then
8654 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8655 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8656 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8657 vv(1)=pizda(1,1)-pizda(2,2)
8658 vv(2)=pizda(2,1)+pizda(1,2)
8659 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8660 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8661 else if (j.gt.1) then
8662 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8663 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8664 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8665 vv(1)=pizda(1,1)-pizda(2,2)
8666 vv(2)=pizda(2,1)+pizda(1,2)
8667 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8668 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8669 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8671 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8674 C Cartesian derivatives.
8681 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8683 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8687 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8689 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8693 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8695 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8697 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8698 & b1(1,itj1),auxvec(1))
8699 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8701 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8702 & b1(1,itl1),auxvec(1))
8703 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8705 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8707 vv(1)=pizda(1,1)-pizda(2,2)
8708 vv(2)=pizda(2,1)+pizda(1,2)
8709 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8711 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8713 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8716 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8719 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8722 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8724 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8726 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8730 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8732 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8735 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8737 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8745 c----------------------------------------------------------------------------
8746 double precision function eello_turn6(i,jj,kk)
8747 implicit real*8 (a-h,o-z)
8748 include 'DIMENSIONS'
8749 include 'DIMENSIONS.ZSCOPT'
8750 include 'COMMON.IOUNITS'
8751 include 'COMMON.CHAIN'
8752 include 'COMMON.DERIV'
8753 include 'COMMON.INTERACT'
8754 include 'COMMON.CONTACTS'
8755 include 'COMMON.TORSION'
8756 include 'COMMON.VAR'
8757 include 'COMMON.GEO'
8758 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8759 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8761 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8762 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8763 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8764 C the respective energy moment and not to the cluster cumulant.
8769 iti=itortyp(itype(i))
8770 itk=itortyp(itype(k))
8771 itk1=itortyp(itype(k+1))
8772 itl=itortyp(itype(l))
8773 itj=itortyp(itype(j))
8774 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8775 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8776 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8781 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8783 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8787 derx_turn(lll,kkk,iii)=0.0d0
8794 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8796 cd write (2,*) 'eello6_5',eello6_5
8798 call transpose2(AEA(1,1,1),auxmat(1,1))
8799 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8800 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8801 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8805 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8806 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8807 s2 = scalar2(b1(1,itk),vtemp1(1))
8809 call transpose2(AEA(1,1,2),atemp(1,1))
8810 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8811 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8812 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8816 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8817 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8818 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8820 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8821 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8822 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8823 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8824 ss13 = scalar2(b1(1,itk),vtemp4(1))
8825 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8829 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8835 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8837 C Derivatives in gamma(i+2)
8839 call transpose2(AEA(1,1,1),auxmatd(1,1))
8840 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8841 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8842 call transpose2(AEAderg(1,1,2),atempd(1,1))
8843 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8844 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8848 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8849 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8850 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8856 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8857 C Derivatives in gamma(i+3)
8859 call transpose2(AEA(1,1,1),auxmatd(1,1))
8860 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8861 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8862 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8866 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8867 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8868 s2d = scalar2(b1(1,itk),vtemp1d(1))
8870 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8871 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8873 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8875 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8876 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8877 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8887 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8888 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8890 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8891 & -0.5d0*ekont*(s2d+s12d)
8893 C Derivatives in gamma(i+4)
8894 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8895 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8896 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8898 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8899 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8900 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8910 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8912 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8914 C Derivatives in gamma(i+5)
8916 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8917 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8918 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8922 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8923 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8924 s2d = scalar2(b1(1,itk),vtemp1d(1))
8926 call transpose2(AEA(1,1,2),atempd(1,1))
8927 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8928 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8932 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8933 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8935 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8936 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8937 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8947 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8948 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8950 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8951 & -0.5d0*ekont*(s2d+s12d)
8953 C Cartesian derivatives
8958 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8959 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8960 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8964 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8965 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8967 s2d = scalar2(b1(1,itk),vtemp1d(1))
8969 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8970 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8971 s8d = -(atempd(1,1)+atempd(2,2))*
8972 & scalar2(cc(1,1,itl),vtemp2(1))
8976 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8978 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8979 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8986 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8989 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8993 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8994 & - 0.5d0*(s8d+s12d)
8996 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9005 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9007 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9008 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9009 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9010 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9011 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9013 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9014 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9015 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9019 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9020 cd & 16*eel_turn6_num
9022 if (j.lt.nres-1) then
9029 if (l.lt.nres-1) then
9037 ggg1(ll)=eel_turn6*g_contij(ll,1)
9038 ggg2(ll)=eel_turn6*g_contij(ll,2)
9039 ghalf=0.5d0*ggg1(ll)
9041 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
9042 & +ekont*derx_turn(ll,2,1)
9043 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9044 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
9045 & +ekont*derx_turn(ll,4,1)
9046 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9047 ghalf=0.5d0*ggg2(ll)
9049 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
9050 & +ekont*derx_turn(ll,2,2)
9051 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9052 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
9053 & +ekont*derx_turn(ll,4,2)
9054 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9059 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9064 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9070 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9075 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9079 cd write (2,*) iii,g_corr6_loc(iii)
9082 eello_turn6=ekont*eel_turn6
9083 cd write (2,*) 'ekont',ekont
9084 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9087 crc-------------------------------------------------
9088 SUBROUTINE MATVEC2(A1,V1,V2)
9089 implicit real*8 (a-h,o-z)
9090 include 'DIMENSIONS'
9091 DIMENSION A1(2,2),V1(2),V2(2)
9095 c 3 VI=VI+A1(I,K)*V1(K)
9099 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9100 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9105 C---------------------------------------
9106 SUBROUTINE MATMAT2(A1,A2,A3)
9107 implicit real*8 (a-h,o-z)
9108 include 'DIMENSIONS'
9109 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9110 c DIMENSION AI3(2,2)
9114 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9120 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9121 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9122 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9123 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9131 c-------------------------------------------------------------------------
9132 double precision function scalar2(u,v)
9134 double precision u(2),v(2)
9137 scalar2=u(1)*v(1)+u(2)*v(2)
9141 C-----------------------------------------------------------------------------
9143 subroutine transpose2(a,at)
9145 double precision a(2,2),at(2,2)
9152 c--------------------------------------------------------------------------
9153 subroutine transpose(n,a,at)
9156 double precision a(n,n),at(n,n)
9164 C---------------------------------------------------------------------------
9165 subroutine prodmat3(a1,a2,kk,transp,prod)
9168 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9170 crc double precision auxmat(2,2),prod_(2,2)
9173 crc call transpose2(kk(1,1),auxmat(1,1))
9174 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9175 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9177 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9178 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9179 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9180 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9181 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9182 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9183 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9184 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9187 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9188 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9190 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9191 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9192 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9193 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9194 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9195 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9196 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9197 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9200 c call transpose2(a2(1,1),a2t(1,1))
9203 crc print *,((prod_(i,j),i=1,2),j=1,2)
9204 crc print *,((prod(i,j),i=1,2),j=1,2)
9208 C-----------------------------------------------------------------------------
9209 double precision function scalar(u,v)
9211 double precision u(3),v(3)