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