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)
1077 >>>>>>> e183793... Added src_MD-M-newcorr (Adasko's source) and src-NEWSC of WHAM (with Momo's SCSC potentials)
1078 IF (energy_dec) write (iout,'(a)')
1079 & ' AAi i AAj j 1/rij Rtail Rhead evdwij Fcav Ecl
1080 & Egb Epol Fisocav Elj Equad evdw'
1085 ccccc energy_dec=.false.
1086 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1088 c if (icall.eq.0) lprn=.false.
1091 DO i = iatsc_s, iatsc_e
1093 c itypi1 = itype(i+1)
1094 dxi = dc_norm(1,nres+i)
1095 dyi = dc_norm(2,nres+i)
1096 dzi = dc_norm(3,nres+i)
1097 c dsci_inv=dsc_inv(itypi)
1098 dsci_inv = vbld_inv(i+nres)
1100 c ctail(k,1) = c(k, i+nres)
1101 c & - dtail(1,itypi,itypj) * dc_norm(k, nres+i)
1106 c!-------------------------------------------------------------------
1107 C Calculate SC interaction energy.
1108 DO iint = 1, nint_gr(i)
1109 DO j = istart(i,iint), iend(i,iint)
1110 c! initialize variables for electrostatic gradients
1111 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
1113 c dscj_inv = dsc_inv(itypj)
1114 dscj_inv = vbld_inv(j+nres)
1115 c! rij holds 1/(distance of Calpha atoms)
1116 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
1118 c!-------------------------------------------------------------------
1119 C Calculate angle-dependent terms of energy and contributions to their
1123 c! DO troll = 10, 5000
1127 c! sqom1 = om1 * om1
1128 c! sqom2 = om2 * om2
1129 c! sqom12 = om12 * om12
1130 c! rij = 5.0d0 / troll
1132 c! Rtail = troll / 5.0d0
1133 c! Rhead = troll / 5.0d0
1134 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1135 c! Rtail = dsqrt((Rtail**2)
1136 c! & +((dabs(dtail(1,itypi,itypj)-dtail(2,itypi,itypj)))**2))
1137 c! rij = 1.0d0/Rtail
1141 c! this should be in elgrad_init but om's are calculated by sc_angular
1142 c! which in turn is used by older potentials
1143 c! which proves how tangled UNRES code is >.<
1144 c! om = omega, sqom = om^2
1147 sqom12 = om12 * om12
1149 c! now we calculate EGB - Gey-Berne
1150 c! It will be summed up in evdwij and saved in evdw
1151 sigsq = 1.0D0 / sigsq
1152 sig = sig0ij * dsqrt(sigsq)
1153 c! rij_shift = 1.0D0 / rij - sig + sig0ij
1154 rij_shift = Rtail - sig + sig0ij
1155 c write (2,*) "Rtal",Rtail," sig",sig," sigsq",sigsq,
1156 c & " sig0ij",sig0ij
1157 c write (2,*) "rij_shift",rij_shift
1158 IF (rij_shift.le.0.0D0) THEN
1162 sigder = -sig * sigsq
1163 rij_shift = 1.0D0 / rij_shift
1164 fac = rij_shift**expon
1165 c1 = fac * fac * aa(itypi,itypj)
1169 ! Scale down the repulsive term for 1,4 interactions.
1170 if (iabs(j-i).le.4) c1 = 0.01d0 * c1
1172 >>>>>>> e183793... Added src_MD-M-newcorr (Adasko's source) and src-NEWSC of WHAM (with Momo's SCSC potentials)
1174 c2 = fac * bb(itypi,itypj)
1176 c write (2,*) "eps1",eps1," eps2rt",eps2rt," eps3rt",eps3rt,
1177 c & " c1",c1," c2",c2
1178 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
1179 eps2der = eps3rt * evdwij
1180 eps3der = eps2rt * evdwij
1181 c! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
1182 evdwij = eps2rt * eps3rt * evdwij
1184 c! write (*,*) "Gey Berne = ", evdwij
1186 IF (bb(itypi,itypj).gt.0) THEN
1187 evdw_p = evdw_p + evdwij
1189 evdw_m = evdw_m + evdwij
1195 c!-------------------------------------------------------------------
1196 c! Calculate some components of GGB
1197 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
1198 fac = -expon * (c1 + evdwij) * rij_shift
1199 sigder = fac * sigder
1201 c! Calculate distance derivative
1208 c! write (*,*) "gg(1) = ", gg(1)
1209 c! write (*,*) "gg(2) = ", gg(2)
1210 c! write (*,*) "gg(3) = ", gg(3)
1211 c! The angular derivatives of GGB are brought together in sc_grad
1212 c!-------------------------------------------------------------------
1215 c! Catch gly-gly interactions to skip calculation of something that
1218 IF (itypi.eq.10.and.itypj.eq.10) THEN
1226 c! we are not 2 glycines, so we calculate Fcav (and maybe more)
1227 fac = chis1 * sqom1 + chis2 * sqom2
1228 & - 2.0d0 * chis12 * om1 * om2 * om12
1229 c! we will use pom later in Gcav, so dont mess with it!
1230 pom = 1.0d0 - chis1 * chis2 * sqom12
1232 Lambf = (1.0d0 - (fac / pom))
1233 Lambf = dsqrt(Lambf)
1236 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
1237 c! write (*,*) "sparrow = ", sparrow
1238 Chif = Rtail * sparrow
1239 ChiLambf = Chif * Lambf
1240 eagle = dsqrt(ChiLambf)
1241 bat = ChiLambf ** 11.0d0
1243 top = b1 * ( eagle + b2 * ChiLambf - b3 )
1244 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
1247 c! write (*,*) "sig1 = ",sig1
1248 c! write (*,*) "sig2 = ",sig2
1249 c! write (*,*) "Rtail = ",Rtail
1250 c! write (*,*) "sparrow = ",sparrow
1251 c! write (*,*) "Chis1 = ", chis1
1252 c! write (*,*) "Chis2 = ", chis2
1253 c! write (*,*) "Chis12 = ", chis12
1254 c! write (*,*) "om1 = ", om1
1255 c! write (*,*) "om2 = ", om2
1256 c! write (*,*) "om12 = ", om12
1257 c! write (*,*) "sqom1 = ", sqom1
1258 c! write (*,*) "sqom2 = ", sqom2
1259 c! write (*,*) "sqom12 = ", sqom12
1260 c! write (*,*) "Lambf = ",Lambf
1261 c! write (*,*) "b1 = ",b1
1262 c! write (*,*) "b2 = ",b2
1263 c! write (*,*) "b3 = ",b3
1264 c! write (*,*) "b4 = ",b4
1265 c! write (*,*) "top = ",top
1266 c! write (*,*) "bot = ",bot
1269 c! write (*,*) "Fcav = ", Fcav
1270 c!-------------------------------------------------------------------
1271 c! derivative of Fcav is Gcav...
1272 c!---------------------------------------------------
1274 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
1275 dbot = 12.0d0 * b4 * bat * Lambf
1276 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
1278 c! write (*,*) "dFcav/dR = ", dFdR
1280 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
1281 dbot = 12.0d0 * b4 * bat * Chif
1283 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
1284 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
1285 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2)
1286 & * (chis2 * om2 * om12 - om1) / (eagle * pom)
1288 dFdL = ((dtop * bot - top * dbot) / botsq)
1290 dCAVdOM1 = dFdL * ( dFdOM1 )
1291 dCAVdOM2 = dFdL * ( dFdOM2 )
1292 dCAVdOM12 = dFdL * ( dFdOM12 )
1293 c! write (*,*) "dFcav/dOM1 = ", dCAVdOM1
1294 c! write (*,*) "dFcav/dOM2 = ", dCAVdOM2
1295 c! write (*,*) "dFcav/dOM12 = ", dCAVdOM12
1297 c!-------------------------------------------------------------------
1298 c! Finally, add the distance derivatives of GB and Fcav to gvdwc
1299 c! Pom is used here to project the gradient vector into
1300 c! cartesian coordinates and at the same time contains
1301 c! dXhb/dXsc derivative (for charged amino acids
1302 c! location of hydrophobic centre of interaction is not
1303 c! the same as geometric centre of side chain, this
1304 c! derivative takes that into account)
1305 c! derivatives of omega angles will be added in sc_grad
1308 ertail(k) = Rtail_distance(k)/Rtail
1310 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
1311 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
1312 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1313 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1315 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1316 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1317 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
1318 gvdwx(k,i) = gvdwx(k,i)
1319 & - (( dFdR + gg(k) ) * pom)
1320 c! & - ( dFdR * pom )
1321 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
1322 gvdwx(k,j) = gvdwx(k,j)
1323 & + (( dFdR + gg(k) ) * pom)
1324 c! & + ( dFdR * pom )
1326 gvdwc(k,i) = gvdwc(k,i)
1327 & - (( dFdR + gg(k) ) * ertail(k))
1328 c! & - ( dFdR * ertail(k))
1330 gvdwc(k,j) = gvdwc(k,j)
1331 & + (( dFdR + gg(k) ) * ertail(k))
1332 c! & + ( dFdR * ertail(k))
1335 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1336 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1339 c!-------------------------------------------------------------------
1340 c! Compute head-head and head-tail energies for each state
1342 isel = iabs(Qi) + iabs(Qj)
1344 c! No charges - do nothing
1347 ELSE IF (isel.eq.4) THEN
1348 c! Calculate dipole-dipole interactions
1352 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
1353 c! Charge-nonpolar interactions
1357 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
1358 c! Nonpolar-charge interactions
1362 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
1363 c! Charge-dipole interactions
1364 CALL eqd(ecl, elj, epol)
1365 eheadtail = ECL + elj + epol
1367 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
1368 c! Dipole-charge interactions
1369 CALL edq(ecl, elj, epol)
1370 eheadtail = ECL + elj + epol
1372 ELSE IF ((isel.eq.2.and.
1373 & iabs(Qi).eq.1).and.
1374 & nstate(itypi,itypj).eq.1) THEN
1375 c! Same charge-charge interaction ( +/+ or -/- )
1376 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
1377 eheadtail = ECL + Egb + Epol + Fisocav + Elj
1379 ELSE IF ((isel.eq.2.and.
1380 & iabs(Qi).eq.1).and.
1381 & nstate(itypi,itypj).ne.1) THEN
1382 c! Different charge-charge interaction ( +/- or -/+ )
1384 & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1386 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
1387 c! write (*,*) "evdw = ", evdw
1388 c! write (*,*) "Fcav = ", Fcav
1389 c! write (*,*) "eheadtail = ", eheadtail
1395 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,9f16.7)')
1396 & restyp(itype(i)),i,restyp(itype(j)),j,
1397 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1399 IF (energy_dec) write (*,'(2(1x,a3,i3),3f6.2,9f16.7)')
1400 & restyp(itype(i)),i,restyp(itype(j)),j,
1401 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1404 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)')
1405 & restyp(itype(i)),i,restyp(itype(j)),j,
1406 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1407 & Equad,evdwij+Fcav+eheadtail,evdw
1408 c IF (energy_dec) write (*,'(2(1x,a3,i3),3f6.2,9f16.7)')
1409 c & restyp(itype(i)),i,restyp(itype(j)),j,
1410 c & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1411 c & Equad,evdwij+Fcav+eheadtail,evdw
1412 >>>>>>> e183793... Added src_MD-M-newcorr (Adasko's source) and src-NEWSC of WHAM (with Momo's SCSC potentials)
1418 c!-------------------------------------------------------------------
1419 c! As all angular derivatives are done, now we sum them up,
1420 c! then transform and project into cartesian vectors and add to gvdwc
1421 c! We call sc_grad always, with the exception of +/- interaction.
1422 c! This is because energy_quad subroutine needs to handle
1423 c! this job in his own way.
1424 c! This IS probably not very efficient and SHOULD be optimised
1425 c! but it will require major restructurization of emomo
1426 c! so it will be left as it is for now
1427 c! write (*,*) 'troll1, nstate =', nstate (itypi,itypj)
1428 IF (nstate(itypi,itypj).eq.1) THEN
1430 IF (bb(itypi,itypj).gt.0) THEN
1439 c!-------------------------------------------------------------------
1446 if (energy_dec) write (iout,*) "evdw before exiting emomo:",evdw
1447 >>>>>>> e183793... Added src_MD-M-newcorr (Adasko's source) and src-NEWSC of WHAM (with Momo's SCSC potentials)
1448 c write (iout,*) "Number of loop steps in EGB:",ind
1449 c energy_dec=.false.
1451 END SUBROUTINE emomo
1455 C-----------------------------------------------------------------------------
1458 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
1460 INCLUDE 'DIMENSIONS'
1461 INCLUDE 'DIMENSIONS.ZSCOPT'
1462 INCLUDE 'COMMON.CALC'
1463 INCLUDE 'COMMON.CHAIN'
1464 INCLUDE 'COMMON.CONTROL'
1465 INCLUDE 'COMMON.DERIV'
1466 INCLUDE 'COMMON.EMP'
1467 INCLUDE 'COMMON.GEO'
1468 INCLUDE 'COMMON.INTERACT'
1469 INCLUDE 'COMMON.IOUNITS'
1470 INCLUDE 'COMMON.LOCAL'
1471 INCLUDE 'COMMON.NAMES'
1472 INCLUDE 'COMMON.VAR'
1473 double precision scalar, facd3, facd4, federmaus, adler
1474 c! Epol and Gpol analytical parameters
1475 alphapol1 = alphapol(itypi,itypj)
1476 alphapol2 = alphapol(itypj,itypi)
1477 c! Fisocav and Gisocav analytical parameters
1478 al1 = alphiso(1,itypi,itypj)
1479 al2 = alphiso(2,itypi,itypj)
1480 al3 = alphiso(3,itypi,itypj)
1481 al4 = alphiso(4,itypi,itypj)
1483 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1484 & + sigiso2(itypi,itypj)**2.0d0))
1486 pis = sig0head(itypi,itypj)
1487 eps_head = epshead(itypi,itypj)
1488 Rhead_sq = Rhead * Rhead
1489 c! R1 - distance between head of ith side chain and tail of jth sidechain
1490 c! R2 - distance between head of jth side chain and tail of ith sidechain
1494 c! Calculate head-to-tail distances needed by Epol
1495 R1=R1+(ctail(k,2)-chead(k,1))**2
1496 R2=R2+(chead(k,2)-ctail(k,1))**2
1502 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1503 c! & +dhead(1,1,itypi,itypj))**2))
1504 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1505 c! & +dhead(2,1,itypi,itypj))**2))
1507 c!-------------------------------------------------------------------
1508 c! Coulomb electrostatic interaction
1509 Ecl = (332.0d0 * Qij) / Rhead
1510 c! derivative of Ecl is Gcl...
1511 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
1515 c!-------------------------------------------------------------------
1516 c! Generalised Born Solvent Polarization
1517 c! Charged head polarizes the solvent
1518 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1519 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1520 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1521 c! Derivative of Egb is Ggb...
1522 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1523 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1525 dGGBdR = dGGBdFGB * dFGBdR
1526 c!-------------------------------------------------------------------
1527 c! Fisocav - isotropic cavity creation term
1528 c! or "how much energy it costs to put charged head in water"
1530 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1531 bot = (1.0d0 + al4 * pom**12.0d0)
1534 c! write (*,*) "Rhead = ",Rhead
1535 c! write (*,*) "csig = ",csig
1536 c! write (*,*) "pom = ",pom
1537 c! write (*,*) "al1 = ",al1
1538 c! write (*,*) "al2 = ",al2
1539 c! write (*,*) "al3 = ",al3
1540 c! write (*,*) "al4 = ",al4
1541 c! write (*,*) "top = ",top
1542 c! write (*,*) "bot = ",bot
1543 c! Derivative of Fisocav is GCV...
1544 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1545 dbot = 12.0d0 * al4 * pom ** 11.0d0
1546 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1547 c!-------------------------------------------------------------------
1549 c! Polarization energy - charged heads polarize hydrophobic "neck"
1550 MomoFac1 = (1.0d0 - chi1 * sqom2)
1551 MomoFac2 = (1.0d0 - chi2 * sqom1)
1552 RR1 = ( R1 * R1 ) / MomoFac1
1553 RR2 = ( R2 * R2 ) / MomoFac2
1554 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1555 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1556 fgb1 = sqrt( RR1 + a12sq * ee1 )
1557 fgb2 = sqrt( RR2 + a12sq * ee2 )
1558 epol = 332.0d0 * eps_inout_fac * (
1559 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1561 c write (*,*) "eps_inout_fac = ",eps_inout_fac
1562 c write (*,*) "alphapol1 = ", alphapol1
1563 c write (*,*) "alphapol2 = ", alphapol2
1564 c write (*,*) "fgb1 = ", fgb1
1565 c write (*,*) "fgb2 = ", fgb2
1566 c write (*,*) "epol = ", epol
1567 c! derivative of Epol is Gpol...
1568 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1570 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1572 dFGBdR1 = ( (R1 / MomoFac1)
1573 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1574 & / ( 2.0d0 * fgb1 )
1575 dFGBdR2 = ( (R2 / MomoFac2)
1576 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1577 & / ( 2.0d0 * fgb2 )
1578 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1579 & * ( 2.0d0 - 0.5d0 * ee1) )
1580 & / ( 2.0d0 * fgb1 )
1581 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1582 & * ( 2.0d0 - 0.5d0 * ee2) )
1583 & / ( 2.0d0 * fgb2 )
1584 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1586 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1588 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1590 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1592 c!-------------------------------------------------------------------
1594 c! Lennard-Jones 6-12 interaction between heads
1595 pom = (pis / Rhead)**6.0d0
1596 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1597 c! derivative of Elj is Glj
1598 dGLJdR = 4.0d0 * eps_head
1599 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1600 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1601 c!-------------------------------------------------------------------
1602 c! Return the results
1603 c! These things do the dRdX derivatives, that is
1604 c! allow us to change what we see from function that changes with
1605 c! distance to function that changes with LOCATION (of the interaction
1608 erhead(k) = Rhead_distance(k)/Rhead
1609 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1610 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1613 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1614 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1615 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1616 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1617 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1618 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1619 facd1 = d1 * vbld_inv(i+nres)
1620 facd2 = d2 * vbld_inv(j+nres)
1621 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1622 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1624 c! Now we add appropriate partial derivatives (one in each dimension)
1626 hawk = (erhead_tail(k,1) +
1627 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
1628 condor = (erhead_tail(k,2) +
1629 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
1631 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1632 gvdwx(k,i) = gvdwx(k,i)
1637 & - dPOLdR2 * (erhead_tail(k,2)
1638 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1641 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1642 gvdwx(k,j) = gvdwx(k,j)
1646 & + dPOLdR1 * (erhead_tail(k,1)
1647 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1648 & + dPOLdR2 * condor
1651 gvdwc(k,i) = gvdwc(k,i)
1652 & - dGCLdR * erhead(k)
1653 & - dGGBdR * erhead(k)
1654 & - dGCVdR * erhead(k)
1655 & - dPOLdR1 * erhead_tail(k,1)
1656 & - dPOLdR2 * erhead_tail(k,2)
1657 & - dGLJdR * erhead(k)
1659 gvdwc(k,j) = gvdwc(k,j)
1660 & + dGCLdR * erhead(k)
1661 & + dGGBdR * erhead(k)
1662 & + dGCVdR * erhead(k)
1663 & + dPOLdR1 * erhead_tail(k,1)
1664 & + dPOLdR2 * erhead_tail(k,2)
1665 & + dGLJdR * erhead(k)
1670 c!-------------------------------------------------------------------
1671 SUBROUTINE energy_quad
1672 &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1674 INCLUDE 'DIMENSIONS'
1675 INCLUDE 'DIMENSIONS.ZSCOPT'
1676 INCLUDE 'COMMON.CALC'
1677 INCLUDE 'COMMON.CHAIN'
1678 INCLUDE 'COMMON.CONTROL'
1679 INCLUDE 'COMMON.DERIV'
1680 INCLUDE 'COMMON.EMP'
1681 INCLUDE 'COMMON.GEO'
1682 INCLUDE 'COMMON.INTERACT'
1683 INCLUDE 'COMMON.IOUNITS'
1684 INCLUDE 'COMMON.LOCAL'
1685 INCLUDE 'COMMON.NAMES'
1686 INCLUDE 'COMMON.VAR'
1687 double precision scalar
1688 double precision ener(4)
1689 double precision dcosom1(3),dcosom2(3)
1690 c! used in Epol derivatives
1691 double precision facd3, facd4
1692 double precision federmaus, adler
1693 c! Epol and Gpol analytical parameters
1694 alphapol1 = alphapol(itypi,itypj)
1695 alphapol2 = alphapol(itypj,itypi)
1696 c! Fisocav and Gisocav analytical parameters
1697 al1 = alphiso(1,itypi,itypj)
1698 al2 = alphiso(2,itypi,itypj)
1699 al3 = alphiso(3,itypi,itypj)
1700 al4 = alphiso(4,itypi,itypj)
1702 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1703 & + sigiso2(itypi,itypj)**2.0d0))
1705 w1 = wqdip(1,itypi,itypj)
1706 w2 = wqdip(2,itypi,itypj)
1707 pis = sig0head(itypi,itypj)
1708 eps_head = epshead(itypi,itypj)
1709 c! First things first:
1710 c! We need to do sc_grad's job with GB and Fcav
1712 & eps2der * eps2rt_om1
1713 & - 2.0D0 * alf1 * eps3der
1714 & + sigder * sigsq_om1
1717 & eps2der * eps2rt_om2
1718 & + 2.0D0 * alf2 * eps3der
1719 & + sigder * sigsq_om2
1722 & evdwij * eps1_om12
1723 & + eps2der * eps2rt_om12
1724 & - 2.0D0 * alf12 * eps3der
1725 & + sigder *sigsq_om12
1727 c! now some magical transformations to project gradient into
1728 c! three cartesian vectors
1730 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1731 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1732 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
1733 c! this acts on hydrophobic center of interaction
1734 gvdwx(k,i)= gvdwx(k,i) - gg(k)
1735 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1736 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1737 gvdwx(k,j)= gvdwx(k,j) + gg(k)
1738 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1739 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1740 c! this acts on Calpha
1741 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1742 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1744 c! sc_grad is done, now we will compute
1753 c! d1 = dhead(1, 1, itypi, itypj)
1754 c! d2 = dhead(2, 1, itypi, itypj)
1755 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1756 c! & +dhead(1,ii,itypi,itypj))**2))
1757 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1758 c! & +dhead(2,jj,itypi,itypj))**2))
1759 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1760 c! END OF ENERGY DEBUG
1761 c*************************************************************
1762 DO istate = 1, nstate(itypi,itypj)
1763 c*************************************************************
1764 IF (istate.ne.1) THEN
1765 IF (istate.lt.3) THEN
1771 d1 = dhead(1,ii,itypi,itypj)
1772 d2 = dhead(2,jj,itypi,itypj)
1774 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
1775 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
1776 Rhead_distance(k) = chead(k,2) - chead(k,1)
1778 c! pitagoras (root of sum of squares)
1780 & (Rhead_distance(1)*Rhead_distance(1))
1781 & + (Rhead_distance(2)*Rhead_distance(2))
1782 & + (Rhead_distance(3)*Rhead_distance(3)))
1784 Rhead_sq = Rhead * Rhead
1786 c! R1 - distance between head of ith side chain and tail of jth sidechain
1787 c! R2 - distance between head of jth side chain and tail of ith sidechain
1791 c! Calculate head-to-tail distances
1792 R1=R1+(ctail(k,2)-chead(k,1))**2
1793 R2=R2+(chead(k,2)-ctail(k,1))**2
1800 c! write (*,*) "istate = ", istate
1801 c! write (*,*) "ii = ", ii
1802 c! write (*,*) "jj = ", jj
1803 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1804 c! & +dhead(1,ii,itypi,itypj))**2))
1805 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1806 c! & +dhead(2,jj,itypi,itypj))**2))
1807 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1808 c! Rhead_sq = Rhead * Rhead
1809 c! write (*,*) "d1 = ",d1
1810 c! write (*,*) "d2 = ",d2
1811 c! write (*,*) "R1 = ",R1
1812 c! write (*,*) "R2 = ",R2
1813 c! write (*,*) "Rhead = ",Rhead
1814 c! END OF ENERGY DEBUG
1816 c!-------------------------------------------------------------------
1817 c! Coulomb electrostatic interaction
1818 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
1820 c! write (*,*) "Ecl = ", Ecl
1821 c! derivative of Ecl is Gcl...
1822 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
1827 c!-------------------------------------------------------------------
1828 c! Generalised Born Solvent Polarization
1829 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1830 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1831 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1833 c! write (*,*) "a1*a2 = ", a12sq
1834 c! write (*,*) "Rhead = ", Rhead
1835 c! write (*,*) "Rhead_sq = ", Rhead_sq
1836 c! write (*,*) "ee = ", ee
1837 c! write (*,*) "Fgb = ", Fgb
1838 c! write (*,*) "fac = ", eps_inout_fac
1839 c! write (*,*) "Qij = ", Qij
1840 c! write (*,*) "Egb = ", Egb
1841 c! Derivative of Egb is Ggb...
1842 c! dFGBdR is used by Quad's later...
1843 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1844 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1846 dGGBdR = dGGBdFGB * dFGBdR
1848 c!-------------------------------------------------------------------
1849 c! Fisocav - isotropic cavity creation term
1851 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1852 bot = (1.0d0 + al4 * pom**12.0d0)
1856 c! write (*,*) "pom = ",pom
1857 c! write (*,*) "al1 = ",al1
1858 c! write (*,*) "al2 = ",al2
1859 c! write (*,*) "al3 = ",al3
1860 c! write (*,*) "al4 = ",al4
1861 c! write (*,*) "top = ",top
1862 c! write (*,*) "bot = ",bot
1863 c! write (*,*) "Fisocav = ", Fisocav
1865 c! Derivative of Fisocav is GCV...
1866 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1867 dbot = 12.0d0 * al4 * pom ** 11.0d0
1868 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1870 c!-------------------------------------------------------------------
1871 c! Polarization energy
1873 MomoFac1 = (1.0d0 - chi1 * sqom2)
1874 MomoFac2 = (1.0d0 - chi2 * sqom1)
1875 RR1 = ( R1 * R1 ) / MomoFac1
1876 RR2 = ( R2 * R2 ) / MomoFac2
1877 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1878 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1879 fgb1 = sqrt( RR1 + a12sq * ee1 )
1880 fgb2 = sqrt( RR2 + a12sq * ee2 )
1881 epol = 332.0d0 * eps_inout_fac * (
1882 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1884 c! derivative of Epol is Gpol...
1885 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1887 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1889 dFGBdR1 = ( (R1 / MomoFac1)
1890 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1891 & / ( 2.0d0 * fgb1 )
1892 dFGBdR2 = ( (R2 / MomoFac2)
1893 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1894 & / ( 2.0d0 * fgb2 )
1895 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1896 & * ( 2.0d0 - 0.5d0 * ee1) )
1897 & / ( 2.0d0 * fgb1 )
1898 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1899 & * ( 2.0d0 - 0.5d0 * ee2) )
1900 & / ( 2.0d0 * fgb2 )
1901 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1903 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1905 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1907 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1909 c!-------------------------------------------------------------------
1911 pom = (pis / Rhead)**6.0d0
1912 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1914 c! derivative of Elj is Glj
1915 dGLJdR = 4.0d0 * eps_head
1916 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1917 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1919 c!-------------------------------------------------------------------
1921 IF (Wqd.ne.0.0d0) THEN
1922 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0)
1923 & - 37.5d0 * ( sqom1 + sqom2 )
1924 & + 157.5d0 * ( sqom1 * sqom2 )
1925 & - 45.0d0 * om1*om2*om12
1926 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
1929 c! derivative of Equad...
1930 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
1933 & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
1934 c! dQUADdOM1 = 0.0d0
1936 & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
1937 c! dQUADdOM2 = 0.0d0
1939 & * ( 6.0d0*om12 - 45.0d0*om1*om2 )
1940 c! dQUADdOM12 = 0.0d0
1945 c!-------------------------------------------------------------------
1946 c! Return the results
1948 eom1 = dPOLdOM1 + dQUADdOM1
1949 eom2 = dPOLdOM2 + dQUADdOM2
1951 c! now some magical transformations to project gradient into
1952 c! three cartesian vectors
1954 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1955 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1956 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
1960 erhead(k) = Rhead_distance(k)/Rhead
1961 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1962 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1964 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1965 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1966 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1967 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1968 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1969 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1970 facd1 = d1 * vbld_inv(i+nres)
1971 facd2 = d2 * vbld_inv(j+nres)
1972 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1973 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1974 c! Throw the results into gheadtail which holds gradients
1975 c! for each micro-state
1977 hawk = erhead_tail(k,1) +
1978 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
1979 condor = erhead_tail(k,2) +
1980 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
1982 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1983 c! this acts on hydrophobic center of interaction
1984 gheadtail(k,1,1) = gheadtail(k,1,1)
1989 & - dPOLdR2 * (erhead_tail(k,2)
1990 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1994 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1995 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1997 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1998 c! this acts on hydrophobic center of interaction
1999 gheadtail(k,2,1) = gheadtail(k,2,1)
2003 & + dPOLdR1 * (erhead_tail(k,1)
2004 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2005 & + dPOLdR2 * condor
2009 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2010 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2012 c! this acts on Calpha
2013 gheadtail(k,3,1) = gheadtail(k,3,1)
2014 & - dGCLdR * erhead(k)
2015 & - dGGBdR * erhead(k)
2016 & - dGCVdR * erhead(k)
2017 & - dPOLdR1 * erhead_tail(k,1)
2018 & - dPOLdR2 * erhead_tail(k,2)
2019 & - dGLJdR * erhead(k)
2020 & - dQUADdR * erhead(k)
2023 c! this acts on Calpha
2024 gheadtail(k,4,1) = gheadtail(k,4,1)
2025 & + dGCLdR * erhead(k)
2026 & + dGGBdR * erhead(k)
2027 & + dGCVdR * erhead(k)
2028 & + dPOLdR1 * erhead_tail(k,1)
2029 & + dPOLdR2 * erhead_tail(k,2)
2030 & + dGLJdR * erhead(k)
2031 & + dQUADdR * erhead(k)
2034 c! write(*,*) "ECL = ", Ecl
2035 c! write(*,*) "Egb = ", Egb
2036 c! write(*,*) "Epol = ", Epol
2037 c! write(*,*) "Fisocav = ", Fisocav
2038 c! write(*,*) "Elj = ", Elj
2039 c! write(*,*) "Equad = ", Equad
2040 c! write(*,*) "wstate = ", wstate(istate,itypi,itypj)
2041 c! write(*,*) "eheadtail = ", eheadtail
2042 c! write(*,*) "TROLL = ", dexp(-betaT * ener(istate))
2043 c! write(*,*) "dGCLdR = ", dGCLdR
2044 c! write(*,*) "dGGBdR = ", dGGBdR
2045 c! write(*,*) "dGCVdR = ", dGCVdR
2046 c! write(*,*) "dPOLdR1 = ", dPOLdR1
2047 c! write(*,*) "dPOLdR2 = ", dPOLdR2
2048 c! write(*,*) "dGLJdR = ", dGLJdR
2049 c! write(*,*) "dQUADdR = ", dQUADdR
2050 c! write(*,*) "tuna(",k,") = ", tuna(k)
2051 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
2052 eheadtail = eheadtail
2053 & + wstate(istate, itypi, itypj)
2054 & * dexp(-betaT * ener(istate))
2055 c! foreach cartesian dimension
2057 c! foreach of two gvdwx and gvdwc
2059 gheadtail(k,l,2) = gheadtail(k,l,2)
2060 & + wstate( istate, itypi, itypj )
2061 & * dexp(-betaT * ener(istate))
2062 & * gheadtail(k,l,1)
2063 gheadtail(k,l,1) = 0.0d0
2067 c! Here ended the gigantic DO istate = 1, 4, which starts
2068 c! at the beggining of the subroutine
2072 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
2074 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
2075 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
2076 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
2077 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
2079 gheadtail(k,l,1) = 0.0d0
2080 gheadtail(k,l,2) = 0.0d0
2083 eheadtail = (-dlog(eheadtail)) / betaT
2090 END SUBROUTINE energy_quad
2093 c!-------------------------------------------------------------------
2096 SUBROUTINE eqn(Epol)
2098 INCLUDE 'DIMENSIONS'
2099 INCLUDE 'DIMENSIONS.ZSCOPT'
2100 INCLUDE 'COMMON.CALC'
2101 INCLUDE 'COMMON.CHAIN'
2102 INCLUDE 'COMMON.CONTROL'
2103 INCLUDE 'COMMON.DERIV'
2104 INCLUDE 'COMMON.EMP'
2105 INCLUDE 'COMMON.GEO'
2106 INCLUDE 'COMMON.INTERACT'
2107 INCLUDE 'COMMON.IOUNITS'
2108 INCLUDE 'COMMON.LOCAL'
2109 INCLUDE 'COMMON.NAMES'
2110 INCLUDE 'COMMON.VAR'
2111 double precision scalar, facd4, federmaus
2112 alphapol1 = alphapol(itypi,itypj)
2113 c! R1 - distance between head of ith side chain and tail of jth sidechain
2116 c! Calculate head-to-tail distances
2117 R1=R1+(ctail(k,2)-chead(k,1))**2
2122 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2123 c! & +dhead(1,1,itypi,itypj))**2))
2124 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2125 c! & +dhead(2,1,itypi,itypj))**2))
2126 c--------------------------------------------------------------------
2127 c Polarization energy
2129 MomoFac1 = (1.0d0 - chi1 * sqom2)
2130 RR1 = R1 * R1 / MomoFac1
2131 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2132 fgb1 = sqrt( RR1 + a12sq * ee1)
2133 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2135 c!------------------------------------------------------------------
2136 c! derivative of Epol is Gpol...
2137 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2139 dFGBdR1 = ( (R1 / MomoFac1)
2140 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2141 & / ( 2.0d0 * fgb1 )
2142 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2143 & * (2.0d0 - 0.5d0 * ee1) )
2145 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2148 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2150 c!-------------------------------------------------------------------
2151 c! Return the results
2152 c! (see comments in Eqq)
2154 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2156 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2157 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2158 facd1 = d1 * vbld_inv(i+nres)
2159 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2162 hawk = (erhead_tail(k,1) +
2163 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2165 gvdwx(k,i) = gvdwx(k,i)
2167 gvdwx(k,j) = gvdwx(k,j)
2168 & + dPOLdR1 * (erhead_tail(k,1)
2169 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2171 gvdwc(k,i) = gvdwc(k,i)
2172 & - dPOLdR1 * erhead_tail(k,1)
2173 gvdwc(k,j) = gvdwc(k,j)
2174 & + dPOLdR1 * erhead_tail(k,1)
2181 c!-------------------------------------------------------------------
2185 SUBROUTINE enq(Epol)
2187 INCLUDE 'DIMENSIONS'
2188 INCLUDE 'DIMENSIONS.ZSCOPT'
2189 INCLUDE 'COMMON.CALC'
2190 INCLUDE 'COMMON.CHAIN'
2191 INCLUDE 'COMMON.CONTROL'
2192 INCLUDE 'COMMON.DERIV'
2193 INCLUDE 'COMMON.EMP'
2194 INCLUDE 'COMMON.GEO'
2195 INCLUDE 'COMMON.INTERACT'
2196 INCLUDE 'COMMON.IOUNITS'
2197 INCLUDE 'COMMON.LOCAL'
2198 INCLUDE 'COMMON.NAMES'
2199 INCLUDE 'COMMON.VAR'
2200 double precision scalar, facd3, adler
2201 alphapol2 = alphapol(itypj,itypi)
2202 c! R2 - distance between head of jth side chain and tail of ith sidechain
2205 c! Calculate head-to-tail distances
2206 R2=R2+(chead(k,2)-ctail(k,1))**2
2211 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2212 c! & +dhead(1,1,itypi,itypj))**2))
2213 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2214 c! & +dhead(2,1,itypi,itypj))**2))
2215 c------------------------------------------------------------------------
2216 c Polarization energy
2217 MomoFac2 = (1.0d0 - chi2 * sqom1)
2218 RR2 = R2 * R2 / MomoFac2
2219 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2220 fgb2 = sqrt(RR2 + a12sq * ee2)
2221 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2223 c!-------------------------------------------------------------------
2224 c! derivative of Epol is Gpol...
2225 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2227 dFGBdR2 = ( (R2 / MomoFac2)
2228 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2230 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2231 & * (2.0d0 - 0.5d0 * ee2) )
2233 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2235 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2238 c!-------------------------------------------------------------------
2239 c! Return the results
2240 c! (See comments in Eqq)
2242 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2244 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2245 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2246 facd2 = d2 * vbld_inv(j+nres)
2247 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2249 condor = (erhead_tail(k,2)
2250 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2252 gvdwx(k,i) = gvdwx(k,i)
2253 & - dPOLdR2 * (erhead_tail(k,2)
2254 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2255 gvdwx(k,j) = gvdwx(k,j)
2256 & + dPOLdR2 * condor
2258 gvdwc(k,i) = gvdwc(k,i)
2259 & - dPOLdR2 * erhead_tail(k,2)
2260 gvdwc(k,j) = gvdwc(k,j)
2261 & + dPOLdR2 * erhead_tail(k,2)
2268 c!-------------------------------------------------------------------
2271 SUBROUTINE eqd(Ecl,Elj,Epol)
2273 INCLUDE 'DIMENSIONS'
2274 INCLUDE 'DIMENSIONS.ZSCOPT'
2275 INCLUDE 'COMMON.CALC'
2276 INCLUDE 'COMMON.CHAIN'
2277 INCLUDE 'COMMON.CONTROL'
2278 INCLUDE 'COMMON.DERIV'
2279 INCLUDE 'COMMON.EMP'
2280 INCLUDE 'COMMON.GEO'
2281 INCLUDE 'COMMON.INTERACT'
2282 INCLUDE 'COMMON.IOUNITS'
2283 INCLUDE 'COMMON.LOCAL'
2284 INCLUDE 'COMMON.NAMES'
2285 INCLUDE 'COMMON.VAR'
2286 double precision scalar, facd4, federmaus
2287 alphapol1 = alphapol(itypi,itypj)
2288 w1 = wqdip(1,itypi,itypj)
2289 w2 = wqdip(2,itypi,itypj)
2290 pis = sig0head(itypi,itypj)
2291 eps_head = epshead(itypi,itypj)
2292 c!-------------------------------------------------------------------
2293 c! R1 - distance between head of ith side chain and tail of jth sidechain
2296 c! Calculate head-to-tail distances
2297 R1=R1+(ctail(k,2)-chead(k,1))**2
2302 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2303 c! & +dhead(1,1,itypi,itypj))**2))
2304 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2305 c! & +dhead(2,1,itypi,itypj))**2))
2307 c!-------------------------------------------------------------------
2309 sparrow = w1 * Qi * om1
2310 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2311 Ecl = sparrow / Rhead**2.0d0
2312 & - hawk / Rhead**4.0d0
2313 c!-------------------------------------------------------------------
2314 c! derivative of ecl is Gcl
2316 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2317 & + 4.0d0 * hawk / Rhead**5.0d0
2319 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2321 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2322 c--------------------------------------------------------------------
2323 c Polarization energy
2325 MomoFac1 = (1.0d0 - chi1 * sqom2)
2326 RR1 = R1 * R1 / MomoFac1
2327 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2328 fgb1 = sqrt( RR1 + a12sq * ee1)
2329 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2331 c!------------------------------------------------------------------
2332 c! derivative of Epol is Gpol...
2333 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2335 dFGBdR1 = ( (R1 / MomoFac1)
2336 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2337 & / ( 2.0d0 * fgb1 )
2338 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2339 & * (2.0d0 - 0.5d0 * ee1) )
2341 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2344 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2346 c!-------------------------------------------------------------------
2348 pom = (pis / Rhead)**6.0d0
2349 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2350 c! derivative of Elj is Glj
2351 dGLJdR = 4.0d0 * eps_head
2352 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2353 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2354 c!-------------------------------------------------------------------
2355 c! Return the results
2357 erhead(k) = Rhead_distance(k)/Rhead
2358 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2361 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2362 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2363 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2364 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2365 facd1 = d1 * vbld_inv(i+nres)
2366 facd2 = d2 * vbld_inv(j+nres)
2367 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2370 hawk = (erhead_tail(k,1) +
2371 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2373 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2374 gvdwx(k,i) = gvdwx(k,i)
2379 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2380 gvdwx(k,j) = gvdwx(k,j)
2382 & + dPOLdR1 * (erhead_tail(k,1)
2383 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2387 gvdwc(k,i) = gvdwc(k,i)
2388 & - dGCLdR * erhead(k)
2389 & - dPOLdR1 * erhead_tail(k,1)
2390 & - dGLJdR * erhead(k)
2392 gvdwc(k,j) = gvdwc(k,j)
2393 & + dGCLdR * erhead(k)
2394 & + dPOLdR1 * erhead_tail(k,1)
2395 & + dGLJdR * erhead(k)
2402 c!-------------------------------------------------------------------
2405 SUBROUTINE edq(Ecl,Elj,Epol)
2407 INCLUDE 'DIMENSIONS'
2408 INCLUDE 'DIMENSIONS.ZSCOPT'
2409 INCLUDE 'COMMON.CALC'
2410 INCLUDE 'COMMON.CHAIN'
2411 INCLUDE 'COMMON.CONTROL'
2412 INCLUDE 'COMMON.DERIV'
2413 INCLUDE 'COMMON.EMP'
2414 INCLUDE 'COMMON.GEO'
2415 INCLUDE 'COMMON.INTERACT'
2416 INCLUDE 'COMMON.IOUNITS'
2417 INCLUDE 'COMMON.LOCAL'
2418 INCLUDE 'COMMON.NAMES'
2419 INCLUDE 'COMMON.VAR'
2420 double precision scalar, facd3, adler
2421 alphapol2 = alphapol(itypj,itypi)
2422 w1 = wqdip(1,itypi,itypj)
2423 w2 = wqdip(2,itypi,itypj)
2424 pis = sig0head(itypi,itypj)
2425 eps_head = epshead(itypi,itypj)
2426 c!-------------------------------------------------------------------
2427 c! R2 - distance between head of jth side chain and tail of ith sidechain
2430 c! Calculate head-to-tail distances
2431 R2=R2+(chead(k,2)-ctail(k,1))**2
2436 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2437 c! & +dhead(1,1,itypi,itypj))**2))
2438 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2439 c! & +dhead(2,1,itypi,itypj))**2))
2442 c!-------------------------------------------------------------------
2444 sparrow = w1 * Qi * om1
2445 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2446 ECL = sparrow / Rhead**2.0d0
2447 & - hawk / Rhead**4.0d0
2448 c!-------------------------------------------------------------------
2449 c! derivative of ecl is Gcl
2451 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2452 & + 4.0d0 * hawk / Rhead**5.0d0
2454 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2456 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2457 c--------------------------------------------------------------------
2458 c Polarization energy
2460 MomoFac2 = (1.0d0 - chi2 * sqom1)
2461 RR2 = R2 * R2 / MomoFac2
2462 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2463 fgb2 = sqrt(RR2 + a12sq * ee2)
2464 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2466 c! derivative of Epol is Gpol...
2467 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2469 dFGBdR2 = ( (R2 / MomoFac2)
2470 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2472 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2473 & * (2.0d0 - 0.5d0 * ee2) )
2475 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2477 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2480 c!-------------------------------------------------------------------
2482 pom = (pis / Rhead)**6.0d0
2483 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2484 c! derivative of Elj is Glj
2485 dGLJdR = 4.0d0 * eps_head
2486 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2487 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2488 c!-------------------------------------------------------------------
2489 c! Return the results
2490 c! (see comments in Eqq)
2492 erhead(k) = Rhead_distance(k)/Rhead
2493 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2495 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2496 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2497 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2498 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2499 facd1 = d1 * vbld_inv(i+nres)
2500 facd2 = d2 * vbld_inv(j+nres)
2501 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2504 condor = (erhead_tail(k,2)
2505 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2507 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2508 gvdwx(k,i) = gvdwx(k,i)
2510 & - dPOLdR2 * (erhead_tail(k,2)
2511 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2514 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2515 gvdwx(k,j) = gvdwx(k,j)
2517 & + dPOLdR2 * condor
2521 gvdwc(k,i) = gvdwc(k,i)
2522 & - dGCLdR * erhead(k)
2523 & - dPOLdR2 * erhead_tail(k,2)
2524 & - dGLJdR * erhead(k)
2526 gvdwc(k,j) = gvdwc(k,j)
2527 & + dGCLdR * erhead(k)
2528 & + dPOLdR2 * erhead_tail(k,2)
2529 & + dGLJdR * erhead(k)
2536 C--------------------------------------------------------------------
2541 INCLUDE 'DIMENSIONS'
2542 INCLUDE 'DIMENSIONS.ZSCOPT'
2543 INCLUDE 'COMMON.CALC'
2544 INCLUDE 'COMMON.CHAIN'
2545 INCLUDE 'COMMON.CONTROL'
2546 INCLUDE 'COMMON.DERIV'
2547 INCLUDE 'COMMON.EMP'
2548 INCLUDE 'COMMON.GEO'
2549 INCLUDE 'COMMON.INTERACT'
2550 INCLUDE 'COMMON.IOUNITS'
2551 INCLUDE 'COMMON.LOCAL'
2552 INCLUDE 'COMMON.NAMES'
2553 INCLUDE 'COMMON.VAR'
2554 double precision scalar
2555 c! csig = sigiso(itypi,itypj)
2556 w1 = wqdip(1,itypi,itypj)
2557 w2 = wqdip(2,itypi,itypj)
2558 c!-------------------------------------------------------------------
2560 fac = (om12 - 3.0d0 * om1 * om2)
2561 c1 = (w1 / (Rhead**3.0d0)) * fac
2562 c2 = (w2 / Rhead ** 6.0d0)
2563 & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2565 c! write (*,*) "w1 = ", w1
2566 c! write (*,*) "w2 = ", w2
2567 c! write (*,*) "om1 = ", om1
2568 c! write (*,*) "om2 = ", om2
2569 c! write (*,*) "om12 = ", om12
2570 c! write (*,*) "fac = ", fac
2571 c! write (*,*) "c1 = ", c1
2572 c! write (*,*) "c2 = ", c2
2573 c! write (*,*) "Ecl = ", Ecl
2574 c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
2575 c! write (*,*) "c2_2 = ",
2576 c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2577 c!-------------------------------------------------------------------
2578 c! dervative of ECL is GCL...
2580 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
2581 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0)
2582 & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
2585 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
2586 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2587 & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
2590 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
2591 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2592 & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
2595 c1 = w1 / (Rhead ** 3.0d0)
2596 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
2598 c!-------------------------------------------------------------------
2599 c! Return the results
2600 c! (see comments in Eqq)
2602 erhead(k) = Rhead_distance(k)/Rhead
2604 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2605 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2606 facd1 = d1 * vbld_inv(i+nres)
2607 facd2 = d2 * vbld_inv(j+nres)
2610 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2611 gvdwx(k,i) = gvdwx(k,i)
2613 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2614 gvdwx(k,j) = gvdwx(k,j)
2617 gvdwc(k,i) = gvdwc(k,i)
2618 & - dGCLdR * erhead(k)
2619 gvdwc(k,j) = gvdwc(k,j)
2620 & + dGCLdR * erhead(k)
2626 c!-------------------------------------------------------------------
2629 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
2632 INCLUDE 'DIMENSIONS'
2633 c! itypi, itypj, i, j, k, l, chead,
2634 INCLUDE 'COMMON.CALC'
2636 INCLUDE 'COMMON.CHAIN'
2638 INCLUDE 'COMMON.DERIV'
2639 c! electrostatic gradients-specific variables
2640 INCLUDE 'COMMON.EMP'
2641 c! wquad, dhead, alphiso, alphasur, rborn, epsintab
2642 INCLUDE 'COMMON.INTERACT'
2643 c! io for debug, disable it in final builds
2644 INCLUDE 'COMMON.IOUNITS'
2645 c!-------------------------------------------------------------------
2648 c! what amino acid is the aminoacid j'th?
2650 c! 1/(Gas Constant * Thermostate temperature) = BetaT
2651 c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
2652 BetaT = 1.0d0 / (298 * 1.987d-3)
2654 sig0ij = sigma( itypi,itypj )
2655 chi1 = chi( itypi, itypj )
2656 chi2 = chi( itypj, itypi )
2658 chip1 = chipp( itypi, itypj )
2659 chip2 = chipp( itypj, itypi )
2660 chip12 = chip1 * chip2
2661 c! write (2,*) "elgrad types",itypi,itypj,
2662 c! & " chi1",chi1," chi2",chi2," chi12",chi12,
2663 c! & " chip1",chip1," chip2",chip2," chip12",chip12
2664 c! not used by momo potential, but needed by sc_angular which is shared
2665 c! by all energy_potential subroutines
2669 c! location, location, location
2670 xj = c( 1, nres+j ) - xi
2671 yj = c( 2, nres+j ) - yi
2672 zj = c( 3, nres+j ) - zi
2673 dxj = dc_norm( 1, nres+j )
2674 dyj = dc_norm( 2, nres+j )
2675 dzj = dc_norm( 3, nres+j )
2676 c! distance from center of chain(?) to polar/charged head
2677 c! write (*,*) "istate = ", 1
2678 c! write (*,*) "ii = ", 1
2679 c! write (*,*) "jj = ", 1
2680 d1 = dhead(1, 1, itypi, itypj)
2681 d2 = dhead(2, 1, itypi, itypj)
2683 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
2684 c! a12sq = a12sq * a12sq
2685 c! charge of amino acid itypi is...
2690 chis1 = chis(itypi,itypj)
2691 chis2 = chis(itypj,itypi)
2692 chis12 = chis1 * chis2
2693 sig1 = sigmap1(itypi,itypj)
2694 sig2 = sigmap2(itypi,itypj)
2695 c! write (*,*) "sig1 = ", sig1
2696 c! write (*,*) "sig2 = ", sig2
2697 c! alpha factors from Fcav/Gcav
2698 b1 = alphasur(1,itypi,itypj)
2699 b2 = alphasur(2,itypi,itypj)
2700 b3 = alphasur(3,itypi,itypj)
2701 b4 = alphasur(4,itypi,itypj)
2702 c! used to determine whether we want to do quadrupole calculations
2703 wqd = wquad(itypi, itypj)
2705 eps_in = epsintab(itypi,itypj)
2706 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
2707 c! write (*,*) "eps_inout_fac = ", eps_inout_fac
2708 c!-------------------------------------------------------------------
2709 c! tail location and distance calculations
2712 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
2713 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
2715 c! tail distances will be themselves usefull elswhere
2716 c1 (in Gcav, for example)
2717 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
2718 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
2719 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
2721 & (Rtail_distance(1)*Rtail_distance(1))
2722 & + (Rtail_distance(2)*Rtail_distance(2))
2723 & + (Rtail_distance(3)*Rtail_distance(3)))
2724 c!-------------------------------------------------------------------
2725 c! Calculate location and distance between polar heads
2726 c! distance between heads
2727 c! for each one of our three dimensional space...
2729 c! location of polar head is computed by taking hydrophobic centre
2730 c! and moving by a d1 * dc_norm vector
2731 c! see unres publications for very informative images
2732 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
2733 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
2735 c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
2736 c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
2737 Rhead_distance(k) = chead(k,2) - chead(k,1)
2739 c! pitagoras (root of sum of squares)
2741 & (Rhead_distance(1)*Rhead_distance(1))
2742 & + (Rhead_distance(2)*Rhead_distance(2))
2743 & + (Rhead_distance(3)*Rhead_distance(3)))
2744 c!-------------------------------------------------------------------
2745 c! zero everything that should be zero'ed
2758 END SUBROUTINE elgrad_init
2759 c!-------------------------------------------------------------------
2760 subroutine sc_angular
2761 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2762 C om12. Called by ebp, egb, and egbv.
2764 include 'COMMON.CALC'
2765 include 'COMMON.IOUNITS'
2769 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2770 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2771 om12=dxi*dxj+dyi*dyj+dzi*dzj
2776 C Calculate eps1(om12) and its derivative in om12
2777 faceps1=1.0D0-om12*chiom12
2778 faceps1_inv=1.0D0/faceps1
2779 eps1=dsqrt(faceps1_inv)
2780 c write (2,*) "chi1",chi1," chi2",chi2," chi12",chi12
2781 c write (2,*) "fsceps1",faceps1," faceps1_inv",faceps1_inv,
2783 C Following variable is eps1*deps1/dom12
2784 eps1_om12=faceps1_inv*chiom12
2789 c write (iout,*) "om12",om12," eps1",eps1
2790 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2795 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2796 sigsq=1.0D0-facsig*faceps1_inv
2797 c write (2,*) "om1",om1," om2",om2," om1om2",om1om2,
2798 c & " chiom1",chiom1,
2799 c & " chiom2",chiom2," facsig",facsig," sigsq",sigsq
2800 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2801 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2802 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2808 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2809 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2811 C Calculate eps2 and its derivatives in om1, om2, and om12.
2814 chipom12=chip12*om12
2815 facp=1.0D0-om12*chipom12
2817 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2818 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2819 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2820 C Following variable is the square root of eps2
2821 eps2rt=1.0D0-facp1*facp_inv
2822 C Following three variables are the derivatives of the square root of eps
2823 C in om1, om2, and om12.
2824 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2825 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2826 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2827 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2828 c! Note that THIS is 0 in emomo, so we should probably move it out of sc_angular
2829 c! Or frankly, we should restructurize the whole energy section
2830 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2831 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2832 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2833 c & " eps2rt_om12",eps2rt_om12
2834 C Calculate whole angle-dependent part of epsilon and contributions
2835 C to its derivatives
2838 C----------------------------------------------------------------------------
2840 implicit real*8 (a-h,o-z)
2841 include 'DIMENSIONS'
2842 include 'DIMENSIONS.ZSCOPT'
2843 include 'COMMON.CHAIN'
2844 include 'COMMON.DERIV'
2845 include 'COMMON.CALC'
2846 double precision dcosom1(3),dcosom2(3)
2847 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2848 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2849 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2850 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2852 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2853 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2856 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2859 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2860 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2861 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2862 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2863 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2864 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2867 C Calculate the components of the gradient in DC and X
2871 gvdwc(l,k)=gvdwc(l,k)+gg(l)
2876 c------------------------------------------------------------------------------
2877 subroutine vec_and_deriv
2878 implicit real*8 (a-h,o-z)
2879 include 'DIMENSIONS'
2880 include 'DIMENSIONS.ZSCOPT'
2881 include 'COMMON.IOUNITS'
2882 include 'COMMON.GEO'
2883 include 'COMMON.VAR'
2884 include 'COMMON.LOCAL'
2885 include 'COMMON.CHAIN'
2886 include 'COMMON.VECTORS'
2887 include 'COMMON.DERIV'
2888 include 'COMMON.INTERACT'
2889 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2890 C Compute the local reference systems. For reference system (i), the
2891 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2892 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2894 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
2895 if (i.eq.nres-1) then
2896 C Case of the last full residue
2897 C Compute the Z-axis
2898 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2899 costh=dcos(pi-theta(nres))
2900 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2905 C Compute the derivatives of uz
2907 uzder(2,1,1)=-dc_norm(3,i-1)
2908 uzder(3,1,1)= dc_norm(2,i-1)
2909 uzder(1,2,1)= dc_norm(3,i-1)
2911 uzder(3,2,1)=-dc_norm(1,i-1)
2912 uzder(1,3,1)=-dc_norm(2,i-1)
2913 uzder(2,3,1)= dc_norm(1,i-1)
2916 uzder(2,1,2)= dc_norm(3,i)
2917 uzder(3,1,2)=-dc_norm(2,i)
2918 uzder(1,2,2)=-dc_norm(3,i)
2920 uzder(3,2,2)= dc_norm(1,i)
2921 uzder(1,3,2)= dc_norm(2,i)
2922 uzder(2,3,2)=-dc_norm(1,i)
2925 C Compute the Y-axis
2928 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2931 C Compute the derivatives of uy
2934 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2935 & -dc_norm(k,i)*dc_norm(j,i-1)
2936 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2938 uyder(j,j,1)=uyder(j,j,1)-costh
2939 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2944 uygrad(l,k,j,i)=uyder(l,k,j)
2945 uzgrad(l,k,j,i)=uzder(l,k,j)
2949 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2950 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2951 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2952 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2956 C Compute the Z-axis
2957 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2958 costh=dcos(pi-theta(i+2))
2959 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2964 C Compute the derivatives of uz
2966 uzder(2,1,1)=-dc_norm(3,i+1)
2967 uzder(3,1,1)= dc_norm(2,i+1)
2968 uzder(1,2,1)= dc_norm(3,i+1)
2970 uzder(3,2,1)=-dc_norm(1,i+1)
2971 uzder(1,3,1)=-dc_norm(2,i+1)
2972 uzder(2,3,1)= dc_norm(1,i+1)
2975 uzder(2,1,2)= dc_norm(3,i)
2976 uzder(3,1,2)=-dc_norm(2,i)
2977 uzder(1,2,2)=-dc_norm(3,i)
2979 uzder(3,2,2)= dc_norm(1,i)
2980 uzder(1,3,2)= dc_norm(2,i)
2981 uzder(2,3,2)=-dc_norm(1,i)
2984 C Compute the Y-axis
2987 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2990 C Compute the derivatives of uy
2993 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2994 & -dc_norm(k,i)*dc_norm(j,i+1)
2995 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2997 uyder(j,j,1)=uyder(j,j,1)-costh
2998 uyder(j,j,2)=1.0d0+uyder(j,j,2)
3003 uygrad(l,k,j,i)=uyder(l,k,j)
3004 uzgrad(l,k,j,i)=uzder(l,k,j)
3008 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3009 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3010 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3011 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3017 vbld_inv_temp(1)=vbld_inv(i+1)
3018 if (i.lt.nres-1) then
3019 vbld_inv_temp(2)=vbld_inv(i+2)
3021 vbld_inv_temp(2)=vbld_inv(i)
3026 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
3027 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
3035 C-----------------------------------------------------------------------------
3036 subroutine vec_and_deriv_test
3037 implicit real*8 (a-h,o-z)
3038 include 'DIMENSIONS'
3039 include 'DIMENSIONS.ZSCOPT'
3040 include 'COMMON.IOUNITS'
3041 include 'COMMON.GEO'
3042 include 'COMMON.VAR'
3043 include 'COMMON.LOCAL'
3044 include 'COMMON.CHAIN'
3045 include 'COMMON.VECTORS'
3046 dimension uyder(3,3,2),uzder(3,3,2)
3047 C Compute the local reference systems. For reference system (i), the
3048 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
3049 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
3051 if (i.eq.nres-1) then
3052 C Case of the last full residue
3053 C Compute the Z-axis
3054 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
3055 costh=dcos(pi-theta(nres))
3056 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3057 c write (iout,*) 'fac',fac,
3058 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
3059 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
3063 C Compute the derivatives of uz
3065 uzder(2,1,1)=-dc_norm(3,i-1)
3066 uzder(3,1,1)= dc_norm(2,i-1)
3067 uzder(1,2,1)= dc_norm(3,i-1)
3069 uzder(3,2,1)=-dc_norm(1,i-1)
3070 uzder(1,3,1)=-dc_norm(2,i-1)
3071 uzder(2,3,1)= dc_norm(1,i-1)
3074 uzder(2,1,2)= dc_norm(3,i)
3075 uzder(3,1,2)=-dc_norm(2,i)
3076 uzder(1,2,2)=-dc_norm(3,i)
3078 uzder(3,2,2)= dc_norm(1,i)
3079 uzder(1,3,2)= dc_norm(2,i)
3080 uzder(2,3,2)=-dc_norm(1,i)
3082 C Compute the Y-axis
3084 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
3087 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
3088 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
3089 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
3091 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
3094 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
3095 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
3098 c write (iout,*) 'facy',facy,
3099 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3100 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3102 uy(k,i)=facy*uy(k,i)
3104 C Compute the derivatives of uy
3107 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
3108 & -dc_norm(k,i)*dc_norm(j,i-1)
3109 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3111 c uyder(j,j,1)=uyder(j,j,1)-costh
3112 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
3113 uyder(j,j,1)=uyder(j,j,1)
3114 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
3115 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
3121 uygrad(l,k,j,i)=uyder(l,k,j)
3122 uzgrad(l,k,j,i)=uzder(l,k,j)
3126 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3127 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3128 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3129 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3132 C Compute the Z-axis
3133 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
3134 costh=dcos(pi-theta(i+2))
3135 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3136 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
3140 C Compute the derivatives of uz
3142 uzder(2,1,1)=-dc_norm(3,i+1)
3143 uzder(3,1,1)= dc_norm(2,i+1)
3144 uzder(1,2,1)= dc_norm(3,i+1)
3146 uzder(3,2,1)=-dc_norm(1,i+1)
3147 uzder(1,3,1)=-dc_norm(2,i+1)
3148 uzder(2,3,1)= dc_norm(1,i+1)
3151 uzder(2,1,2)= dc_norm(3,i)
3152 uzder(3,1,2)=-dc_norm(2,i)
3153 uzder(1,2,2)=-dc_norm(3,i)
3155 uzder(3,2,2)= dc_norm(1,i)
3156 uzder(1,3,2)= dc_norm(2,i)
3157 uzder(2,3,2)=-dc_norm(1,i)
3159 C Compute the Y-axis
3161 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
3162 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
3163 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
3165 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
3168 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
3169 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
3172 c write (iout,*) 'facy',facy,
3173 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3174 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3176 uy(k,i)=facy*uy(k,i)
3178 C Compute the derivatives of uy
3181 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
3182 & -dc_norm(k,i)*dc_norm(j,i+1)
3183 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3185 c uyder(j,j,1)=uyder(j,j,1)-costh
3186 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
3187 uyder(j,j,1)=uyder(j,j,1)
3188 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
3189 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
3195 uygrad(l,k,j,i)=uyder(l,k,j)
3196 uzgrad(l,k,j,i)=uzder(l,k,j)
3200 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3201 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3202 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3203 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3210 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
3211 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
3218 C-----------------------------------------------------------------------------
3219 subroutine check_vecgrad
3220 implicit real*8 (a-h,o-z)
3221 include 'DIMENSIONS'
3222 include 'DIMENSIONS.ZSCOPT'
3223 include 'COMMON.IOUNITS'
3224 include 'COMMON.GEO'
3225 include 'COMMON.VAR'
3226 include 'COMMON.LOCAL'
3227 include 'COMMON.CHAIN'
3228 include 'COMMON.VECTORS'
3229 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
3230 dimension uyt(3,maxres),uzt(3,maxres)
3231 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
3232 double precision delta /1.0d-7/
3235 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
3236 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
3237 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
3238 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
3239 cd & (dc_norm(if90,i),if90=1,3)
3240 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
3241 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
3242 cd write(iout,'(a)')
3248 uygradt(l,k,j,i)=uygrad(l,k,j,i)
3249 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
3262 cd write (iout,*) 'i=',i
3264 erij(k)=dc_norm(k,i)
3268 dc_norm(k,i)=erij(k)
3270 dc_norm(j,i)=dc_norm(j,i)+delta
3271 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
3273 c dc_norm(k,i)=dc_norm(k,i)/fac
3275 c write (iout,*) (dc_norm(k,i),k=1,3)
3276 c write (iout,*) (erij(k),k=1,3)
3279 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
3280 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
3281 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
3282 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
3284 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3285 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
3286 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
3289 dc_norm(k,i)=erij(k)
3292 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3293 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
3294 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
3295 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3296 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
3297 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
3298 cd write (iout,'(a)')
3303 C--------------------------------------------------------------------------
3304 subroutine set_matrices
3305 implicit real*8 (a-h,o-z)
3306 include 'DIMENSIONS'
3307 include 'DIMENSIONS.ZSCOPT'
3308 include 'COMMON.IOUNITS'
3309 include 'COMMON.GEO'
3310 include 'COMMON.VAR'
3311 include 'COMMON.LOCAL'
3312 include 'COMMON.CHAIN'
3313 include 'COMMON.DERIV'
3314 include 'COMMON.INTERACT'
3315 include 'COMMON.CONTACTS'
3316 include 'COMMON.TORSION'
3317 include 'COMMON.VECTORS'
3318 include 'COMMON.FFIELD'
3319 double precision auxvec(2),auxmat(2,2)
3321 C Compute the virtual-bond-torsional-angle dependent quantities needed
3322 C to calculate the el-loc multibody terms of various order.
3325 if (i .lt. nres+1) then
3362 if (i .gt. 3 .and. i .lt. nres+1) then
3363 obrot_der(1,i-2)=-sin1
3364 obrot_der(2,i-2)= cos1
3365 Ugder(1,1,i-2)= sin1
3366 Ugder(1,2,i-2)=-cos1
3367 Ugder(2,1,i-2)=-cos1
3368 Ugder(2,2,i-2)=-sin1
3371 obrot2_der(1,i-2)=-dwasin2
3372 obrot2_der(2,i-2)= dwacos2
3373 Ug2der(1,1,i-2)= dwasin2
3374 Ug2der(1,2,i-2)=-dwacos2
3375 Ug2der(2,1,i-2)=-dwacos2
3376 Ug2der(2,2,i-2)=-dwasin2
3378 obrot_der(1,i-2)=0.0d0
3379 obrot_der(2,i-2)=0.0d0
3380 Ugder(1,1,i-2)=0.0d0
3381 Ugder(1,2,i-2)=0.0d0
3382 Ugder(2,1,i-2)=0.0d0
3383 Ugder(2,2,i-2)=0.0d0
3384 obrot2_der(1,i-2)=0.0d0
3385 obrot2_der(2,i-2)=0.0d0
3386 Ug2der(1,1,i-2)=0.0d0
3387 Ug2der(1,2,i-2)=0.0d0
3388 Ug2der(2,1,i-2)=0.0d0
3389 Ug2der(2,2,i-2)=0.0d0
3391 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
3392 iti = itortyp(itype(i-2))
3396 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3397 iti1 = itortyp(itype(i-1))
3401 cd write (iout,*) '*******i',i,' iti1',iti
3402 cd write (iout,*) 'b1',b1(:,iti)
3403 cd write (iout,*) 'b2',b2(:,iti)
3404 cd write (iout,*) 'Ug',Ug(:,:,i-2)
3405 if (i .gt. iatel_s+2) then
3406 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
3407 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
3408 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
3409 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
3410 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3411 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
3412 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
3422 DtUg2(l,k,i-2)=0.0d0
3426 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
3427 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
3428 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3429 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3430 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3431 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3432 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3434 muder(k,i-2)=Ub2der(k,i-2)
3436 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3437 iti1 = itortyp(itype(i-1))
3442 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
3444 C Vectors and matrices dependent on a single virtual-bond dihedral.
3445 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
3446 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3447 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3448 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3449 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3450 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3451 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3452 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3453 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3454 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
3455 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
3457 C Matrices dependent on two consecutive virtual-bond dihedrals.
3458 C The order of matrices is from left to right.
3460 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3461 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3462 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3463 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3464 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3465 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3466 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3467 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3470 cd iti = itortyp(itype(i))
3473 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3474 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3479 C--------------------------------------------------------------------------
3480 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3482 C This subroutine calculates the average interaction energy and its gradient
3483 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3484 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3485 C The potential depends both on the distance of peptide-group centers and on
3486 C the orientation of the CA-CA virtual bonds.
3488 implicit real*8 (a-h,o-z)
3489 include 'DIMENSIONS'
3490 include 'DIMENSIONS.ZSCOPT'
3491 include 'COMMON.CONTROL'
3492 include 'COMMON.IOUNITS'
3493 include 'COMMON.GEO'
3494 include 'COMMON.VAR'
3495 include 'COMMON.LOCAL'
3496 include 'COMMON.CHAIN'
3497 include 'COMMON.DERIV'
3498 include 'COMMON.INTERACT'
3499 include 'COMMON.CONTACTS'
3500 include 'COMMON.TORSION'
3501 include 'COMMON.VECTORS'
3502 include 'COMMON.FFIELD'
3503 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3504 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3505 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3506 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3507 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
3508 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3509 double precision scal_el /0.5d0/
3511 C 13-go grudnia roku pamietnego...
3512 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3513 & 0.0d0,1.0d0,0.0d0,
3514 & 0.0d0,0.0d0,1.0d0/
3515 cd write(iout,*) 'In EELEC'
3517 cd write(iout,*) 'Type',i
3518 cd write(iout,*) 'B1',B1(:,i)
3519 cd write(iout,*) 'B2',B2(:,i)
3520 cd write(iout,*) 'CC',CC(:,:,i)
3521 cd write(iout,*) 'DD',DD(:,:,i)
3522 cd write(iout,*) 'EE',EE(:,:,i)
3524 cd call check_vecgrad
3526 if (icheckgrad.eq.1) then
3528 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3530 dc_norm(k,i)=dc(k,i)*fac
3532 c write (iout,*) 'i',i,' fac',fac
3535 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3536 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3537 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3538 cd if (wel_loc.gt.0.0d0) then
3539 if (icheckgrad.eq.1) then
3540 call vec_and_deriv_test
3547 cd write (iout,*) 'i=',i
3549 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3552 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3553 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3566 cd print '(a)','Enter EELEC'
3567 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3569 gel_loc_loc(i)=0.0d0
3572 do i=iatel_s,iatel_e
3573 if (itel(i).eq.0) goto 1215
3577 dx_normi=dc_norm(1,i)
3578 dy_normi=dc_norm(2,i)
3579 dz_normi=dc_norm(3,i)
3580 xmedi=c(1,i)+0.5d0*dxi
3581 ymedi=c(2,i)+0.5d0*dyi
3582 zmedi=c(3,i)+0.5d0*dzi
3584 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3585 do j=ielstart(i),ielend(i)
3586 if (itel(j).eq.0) goto 1216
3590 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3591 aaa=app(iteli,itelj)
3592 bbb=bpp(iteli,itelj)
3593 C Diagnostics only!!!
3599 ael6i=ael6(iteli,itelj)
3600 ael3i=ael3(iteli,itelj)
3604 dx_normj=dc_norm(1,j)
3605 dy_normj=dc_norm(2,j)
3606 dz_normj=dc_norm(3,j)
3607 xj=c(1,j)+0.5D0*dxj-xmedi
3608 yj=c(2,j)+0.5D0*dyj-ymedi
3609 zj=c(3,j)+0.5D0*dzj-zmedi
3610 rij=xj*xj+yj*yj+zj*zj
3616 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3617 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3618 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3619 fac=cosa-3.0D0*cosb*cosg
3621 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3622 if (j.eq.i+2) ev1=scal_el*ev1
3627 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3630 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
3631 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3632 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3635 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3636 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3637 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3638 cd & xmedi,ymedi,zmedi,xj,yj,zj
3640 C Calculate contributions to the Cartesian gradient.
3643 facvdw=-6*rrmij*(ev1+evdwij)
3644 facel=-3*rrmij*(el1+eesij)
3651 * Radial derivatives. First process both termini of the fragment (i,j)
3658 gelc(k,i)=gelc(k,i)+ghalf
3659 gelc(k,j)=gelc(k,j)+ghalf
3662 * Loop over residues i+1 thru j-1.
3666 gelc(l,k)=gelc(l,k)+ggg(l)
3674 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3675 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3678 * Loop over residues i+1 thru j-1.
3682 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3689 fac=-3*rrmij*(facvdw+facvdw+facel)
3695 * Radial derivatives. First process both termini of the fragment (i,j)
3702 gelc(k,i)=gelc(k,i)+ghalf
3703 gelc(k,j)=gelc(k,j)+ghalf
3706 * Loop over residues i+1 thru j-1.
3710 gelc(l,k)=gelc(l,k)+ggg(l)
3717 ecosa=2.0D0*fac3*fac1+fac4
3720 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3721 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3723 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3724 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3726 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3727 cd & (dcosg(k),k=1,3)
3729 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3733 gelc(k,i)=gelc(k,i)+ghalf
3734 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3735 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3736 gelc(k,j)=gelc(k,j)+ghalf
3737 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3738 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3742 gelc(l,k)=gelc(l,k)+ggg(l)
3747 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3748 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3749 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3751 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3752 C energy of a peptide unit is assumed in the form of a second-order
3753 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3754 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3755 C are computed for EVERY pair of non-contiguous peptide groups.
3757 if (j.lt.nres-1) then
3768 muij(kkk)=mu(k,i)*mu(l,j)
3771 cd write (iout,*) 'EELEC: i',i,' j',j
3772 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3773 cd write(iout,*) 'muij',muij
3774 ury=scalar(uy(1,i),erij)
3775 urz=scalar(uz(1,i),erij)
3776 vry=scalar(uy(1,j),erij)
3777 vrz=scalar(uz(1,j),erij)
3778 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3779 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3780 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3781 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3782 C For diagnostics only
3787 fac=dsqrt(-ael6i)*r3ij
3788 cd write (2,*) 'fac=',fac
3789 C For diagnostics only
3795 cd write (iout,'(4i5,4f10.5)')
3796 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3797 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3798 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
3799 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
3800 cd write (iout,'(4f10.5)')
3801 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3802 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3803 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3804 cd write (iout,'(2i3,9f10.5/)') i,j,
3805 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3807 C Derivatives of the elements of A in virtual-bond vectors
3808 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3815 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3816 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3817 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3818 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3819 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3820 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3821 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3822 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3823 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3824 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3825 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3826 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3836 C Compute radial contributions to the gradient
3858 C Add the contributions coming from er
3861 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3862 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3863 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3864 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3867 C Derivatives in DC(i)
3868 ghalf1=0.5d0*agg(k,1)
3869 ghalf2=0.5d0*agg(k,2)
3870 ghalf3=0.5d0*agg(k,3)
3871 ghalf4=0.5d0*agg(k,4)
3872 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3873 & -3.0d0*uryg(k,2)*vry)+ghalf1
3874 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3875 & -3.0d0*uryg(k,2)*vrz)+ghalf2
3876 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3877 & -3.0d0*urzg(k,2)*vry)+ghalf3
3878 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3879 & -3.0d0*urzg(k,2)*vrz)+ghalf4
3880 C Derivatives in DC(i+1)
3881 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3882 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
3883 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3884 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
3885 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3886 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
3887 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3888 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
3889 C Derivatives in DC(j)
3890 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3891 & -3.0d0*vryg(k,2)*ury)+ghalf1
3892 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3893 & -3.0d0*vrzg(k,2)*ury)+ghalf2
3894 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3895 & -3.0d0*vryg(k,2)*urz)+ghalf3
3896 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3897 & -3.0d0*vrzg(k,2)*urz)+ghalf4
3898 C Derivatives in DC(j+1) or DC(nres-1)
3899 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3900 & -3.0d0*vryg(k,3)*ury)
3901 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3902 & -3.0d0*vrzg(k,3)*ury)
3903 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3904 & -3.0d0*vryg(k,3)*urz)
3905 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3906 & -3.0d0*vrzg(k,3)*urz)
3911 C Derivatives in DC(i+1)
3912 cd aggi1(k,1)=agg(k,1)
3913 cd aggi1(k,2)=agg(k,2)
3914 cd aggi1(k,3)=agg(k,3)
3915 cd aggi1(k,4)=agg(k,4)
3916 C Derivatives in DC(j)
3921 C Derivatives in DC(j+1)
3926 if (j.eq.nres-1 .and. i.lt.j-2) then
3928 aggj1(k,l)=aggj1(k,l)+agg(k,l)
3929 cd aggj1(k,l)=agg(k,l)
3935 C Check the loc-el terms by numerical integration
3945 aggi(k,l)=-aggi(k,l)
3946 aggi1(k,l)=-aggi1(k,l)
3947 aggj(k,l)=-aggj(k,l)
3948 aggj1(k,l)=-aggj1(k,l)
3951 if (j.lt.nres-1) then
3957 aggi(k,l)=-aggi(k,l)
3958 aggi1(k,l)=-aggi1(k,l)
3959 aggj(k,l)=-aggj(k,l)
3960 aggj1(k,l)=-aggj1(k,l)
3971 aggi(k,l)=-aggi(k,l)
3972 aggi1(k,l)=-aggi1(k,l)
3973 aggj(k,l)=-aggj(k,l)
3974 aggj1(k,l)=-aggj1(k,l)
3980 IF (wel_loc.gt.0.0d0) THEN
3981 C Contribution to the local-electrostatic energy coming from the i-j pair
3982 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3984 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3985 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3986 eel_loc=eel_loc+eel_loc_ij
3987 C Partial derivatives in virtual-bond dihedral angles gamma
3990 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3991 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3992 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3993 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3994 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3995 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3996 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
3997 cd write(iout,*) 'agg ',agg
3998 cd write(iout,*) 'aggi ',aggi
3999 cd write(iout,*) 'aggi1',aggi1
4000 cd write(iout,*) 'aggj ',aggj
4001 cd write(iout,*) 'aggj1',aggj1
4003 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4005 ggg(l)=agg(l,1)*muij(1)+
4006 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4010 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4013 C Remaining derivatives of eello
4015 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
4016 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
4017 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
4018 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
4019 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
4020 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
4021 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
4022 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
4026 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4027 C Contributions from turns
4032 call eturn34(i,j,eello_turn3,eello_turn4)
4034 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4035 if (j.gt.i+1 .and. num_conti.le.maxconts) then
4037 C Calculate the contact function. The ith column of the array JCONT will
4038 C contain the numbers of atoms that make contacts with the atom I (of numbers
4039 C greater than I). The arrays FACONT and GACONT will contain the values of
4040 C the contact function and its derivative.
4041 c r0ij=1.02D0*rpp(iteli,itelj)
4042 c r0ij=1.11D0*rpp(iteli,itelj)
4043 r0ij=2.20D0*rpp(iteli,itelj)
4044 c r0ij=1.55D0*rpp(iteli,itelj)
4045 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4046 if (fcont.gt.0.0D0) then
4047 num_conti=num_conti+1
4048 if (num_conti.gt.maxconts) then
4049 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4050 & ' will skip next contacts for this conf.'
4052 jcont_hb(num_conti,i)=j
4053 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4054 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4055 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4057 d_cont(num_conti,i)=rij
4058 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4059 C --- Electrostatic-interaction matrix ---
4060 a_chuj(1,1,num_conti,i)=a22
4061 a_chuj(1,2,num_conti,i)=a23
4062 a_chuj(2,1,num_conti,i)=a32
4063 a_chuj(2,2,num_conti,i)=a33
4064 C --- Gradient of rij
4066 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4069 c a_chuj(1,1,num_conti,i)=-0.61d0
4070 c a_chuj(1,2,num_conti,i)= 0.4d0
4071 c a_chuj(2,1,num_conti,i)= 0.65d0
4072 c a_chuj(2,2,num_conti,i)= 0.50d0
4073 c else if (i.eq.2) then
4074 c a_chuj(1,1,num_conti,i)= 0.0d0
4075 c a_chuj(1,2,num_conti,i)= 0.0d0
4076 c a_chuj(2,1,num_conti,i)= 0.0d0
4077 c a_chuj(2,2,num_conti,i)= 0.0d0
4079 C --- and its gradients
4080 cd write (iout,*) 'i',i,' j',j
4082 cd write (iout,*) 'iii 1 kkk',kkk
4083 cd write (iout,*) agg(kkk,:)
4086 cd write (iout,*) 'iii 2 kkk',kkk
4087 cd write (iout,*) aggi(kkk,:)
4090 cd write (iout,*) 'iii 3 kkk',kkk
4091 cd write (iout,*) aggi1(kkk,:)
4094 cd write (iout,*) 'iii 4 kkk',kkk
4095 cd write (iout,*) aggj(kkk,:)
4098 cd write (iout,*) 'iii 5 kkk',kkk
4099 cd write (iout,*) aggj1(kkk,:)
4106 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4107 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4108 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4109 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4110 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4112 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
4118 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4119 C Calculate contact energies
4121 wij=cosa-3.0D0*cosb*cosg
4124 c fac3=dsqrt(-ael6i)/r0ij**3
4125 fac3=dsqrt(-ael6i)*r3ij
4126 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4127 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4129 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4130 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4131 C Diagnostics. Comment out or remove after debugging!
4132 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4133 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4134 c ees0m(num_conti,i)=0.0D0
4136 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4137 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4138 facont_hb(num_conti,i)=fcont
4140 C Angular derivatives of the contact function
4141 ees0pij1=fac3/ees0pij
4142 ees0mij1=fac3/ees0mij
4143 fac3p=-3.0D0*fac3*rrmij
4144 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4145 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4147 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4148 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4149 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4150 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4151 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4152 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4153 ecosap=ecosa1+ecosa2
4154 ecosbp=ecosb1+ecosb2
4155 ecosgp=ecosg1+ecosg2
4156 ecosam=ecosa1-ecosa2
4157 ecosbm=ecosb1-ecosb2
4158 ecosgm=ecosg1-ecosg2
4167 fprimcont=fprimcont/rij
4168 cd facont_hb(num_conti,i)=1.0D0
4169 C Following line is for diagnostics.
4172 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4173 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4176 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4177 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4179 gggp(1)=gggp(1)+ees0pijp*xj
4180 gggp(2)=gggp(2)+ees0pijp*yj
4181 gggp(3)=gggp(3)+ees0pijp*zj
4182 gggm(1)=gggm(1)+ees0mijp*xj
4183 gggm(2)=gggm(2)+ees0mijp*yj
4184 gggm(3)=gggm(3)+ees0mijp*zj
4185 C Derivatives due to the contact function
4186 gacont_hbr(1,num_conti,i)=fprimcont*xj
4187 gacont_hbr(2,num_conti,i)=fprimcont*yj
4188 gacont_hbr(3,num_conti,i)=fprimcont*zj
4190 ghalfp=0.5D0*gggp(k)
4191 ghalfm=0.5D0*gggm(k)
4192 gacontp_hb1(k,num_conti,i)=ghalfp
4193 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4194 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4195 gacontp_hb2(k,num_conti,i)=ghalfp
4196 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4197 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4198 gacontp_hb3(k,num_conti,i)=gggp(k)
4199 gacontm_hb1(k,num_conti,i)=ghalfm
4200 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4201 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4202 gacontm_hb2(k,num_conti,i)=ghalfm
4203 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4204 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4205 gacontm_hb3(k,num_conti,i)=gggm(k)
4208 C Diagnostics. Comment out or remove after debugging!
4210 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4211 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4212 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4213 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4214 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4215 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4218 endif ! num_conti.le.maxconts
4223 num_cont_hb(i)=num_conti
4227 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
4228 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
4230 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
4231 ccc eel_loc=eel_loc+eello_turn3
4234 C-----------------------------------------------------------------------------
4235 subroutine eturn34(i,j,eello_turn3,eello_turn4)
4236 C Third- and fourth-order contributions from turns
4237 implicit real*8 (a-h,o-z)
4238 include 'DIMENSIONS'
4239 include 'DIMENSIONS.ZSCOPT'
4240 include 'COMMON.IOUNITS'
4241 include 'COMMON.GEO'
4242 include 'COMMON.VAR'
4243 include 'COMMON.LOCAL'
4244 include 'COMMON.CHAIN'
4245 include 'COMMON.DERIV'
4246 include 'COMMON.INTERACT'
4247 include 'COMMON.CONTACTS'
4248 include 'COMMON.TORSION'
4249 include 'COMMON.VECTORS'
4250 include 'COMMON.FFIELD'
4252 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4253 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4254 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
4255 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4256 & aggj(3,4),aggj1(3,4),a_temp(2,2)
4257 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
4259 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4261 C Third-order contributions
4268 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4269 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4270 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4271 call transpose2(auxmat(1,1),auxmat1(1,1))
4272 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4273 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4274 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4275 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4276 cd & ' eello_turn3_num',4*eello_turn3_num
4278 C Derivatives in gamma(i)
4279 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4280 call transpose2(auxmat2(1,1),pizda(1,1))
4281 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4282 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4283 C Derivatives in gamma(i+1)
4284 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4285 call transpose2(auxmat2(1,1),pizda(1,1))
4286 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4287 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4288 & +0.5d0*(pizda(1,1)+pizda(2,2))
4289 C Cartesian derivatives
4291 a_temp(1,1)=aggi(l,1)
4292 a_temp(1,2)=aggi(l,2)
4293 a_temp(2,1)=aggi(l,3)
4294 a_temp(2,2)=aggi(l,4)
4295 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4296 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4297 & +0.5d0*(pizda(1,1)+pizda(2,2))
4298 a_temp(1,1)=aggi1(l,1)
4299 a_temp(1,2)=aggi1(l,2)
4300 a_temp(2,1)=aggi1(l,3)
4301 a_temp(2,2)=aggi1(l,4)
4302 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4303 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4304 & +0.5d0*(pizda(1,1)+pizda(2,2))
4305 a_temp(1,1)=aggj(l,1)
4306 a_temp(1,2)=aggj(l,2)
4307 a_temp(2,1)=aggj(l,3)
4308 a_temp(2,2)=aggj(l,4)
4309 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4310 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4311 & +0.5d0*(pizda(1,1)+pizda(2,2))
4312 a_temp(1,1)=aggj1(l,1)
4313 a_temp(1,2)=aggj1(l,2)
4314 a_temp(2,1)=aggj1(l,3)
4315 a_temp(2,2)=aggj1(l,4)
4316 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4317 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4318 & +0.5d0*(pizda(1,1)+pizda(2,2))
4321 else if (j.eq.i+3) then
4322 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4324 C Fourth-order contributions
4332 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4333 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4334 iti1=itortyp(itype(i+1))
4335 iti2=itortyp(itype(i+2))
4336 iti3=itortyp(itype(i+3))
4337 call transpose2(EUg(1,1,i+1),e1t(1,1))
4338 call transpose2(Eug(1,1,i+2),e2t(1,1))
4339 call transpose2(Eug(1,1,i+3),e3t(1,1))
4340 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4341 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4342 s1=scalar2(b1(1,iti2),auxvec(1))
4343 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4344 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4345 s2=scalar2(b1(1,iti1),auxvec(1))
4346 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4347 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4348 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4349 eello_turn4=eello_turn4-(s1+s2+s3)
4350 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4351 cd & ' eello_turn4_num',8*eello_turn4_num
4352 C Derivatives in gamma(i)
4354 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4355 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4356 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4357 s1=scalar2(b1(1,iti2),auxvec(1))
4358 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4359 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4360 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4361 C Derivatives in gamma(i+1)
4362 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4363 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4364 s2=scalar2(b1(1,iti1),auxvec(1))
4365 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4366 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4367 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4368 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4369 C Derivatives in gamma(i+2)
4370 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4371 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4372 s1=scalar2(b1(1,iti2),auxvec(1))
4373 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4374 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4375 s2=scalar2(b1(1,iti1),auxvec(1))
4376 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
4377 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4378 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4379 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4380 C Cartesian derivatives
4381 C Derivatives of this turn contributions in DC(i+2)
4382 if (j.lt.nres-1) then
4384 a_temp(1,1)=agg(l,1)
4385 a_temp(1,2)=agg(l,2)
4386 a_temp(2,1)=agg(l,3)
4387 a_temp(2,2)=agg(l,4)
4388 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4389 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4390 s1=scalar2(b1(1,iti2),auxvec(1))
4391 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4392 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4393 s2=scalar2(b1(1,iti1),auxvec(1))
4394 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4395 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4396 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4398 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4401 C Remaining derivatives of this turn contribution
4403 a_temp(1,1)=aggi(l,1)
4404 a_temp(1,2)=aggi(l,2)
4405 a_temp(2,1)=aggi(l,3)
4406 a_temp(2,2)=aggi(l,4)
4407 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4408 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4409 s1=scalar2(b1(1,iti2),auxvec(1))
4410 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4411 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4412 s2=scalar2(b1(1,iti1),auxvec(1))
4413 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4414 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4415 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4416 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4417 a_temp(1,1)=aggi1(l,1)
4418 a_temp(1,2)=aggi1(l,2)
4419 a_temp(2,1)=aggi1(l,3)
4420 a_temp(2,2)=aggi1(l,4)
4421 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4422 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4423 s1=scalar2(b1(1,iti2),auxvec(1))
4424 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4425 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4426 s2=scalar2(b1(1,iti1),auxvec(1))
4427 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4428 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4429 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4430 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4431 a_temp(1,1)=aggj(l,1)
4432 a_temp(1,2)=aggj(l,2)
4433 a_temp(2,1)=aggj(l,3)
4434 a_temp(2,2)=aggj(l,4)
4435 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4436 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4437 s1=scalar2(b1(1,iti2),auxvec(1))
4438 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4439 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4440 s2=scalar2(b1(1,iti1),auxvec(1))
4441 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4442 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4443 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4444 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4445 a_temp(1,1)=aggj1(l,1)
4446 a_temp(1,2)=aggj1(l,2)
4447 a_temp(2,1)=aggj1(l,3)
4448 a_temp(2,2)=aggj1(l,4)
4449 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4450 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4451 s1=scalar2(b1(1,iti2),auxvec(1))
4452 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4453 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4454 s2=scalar2(b1(1,iti1),auxvec(1))
4455 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4456 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4457 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4458 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4464 C-----------------------------------------------------------------------------
4465 subroutine vecpr(u,v,w)
4466 implicit real*8(a-h,o-z)
4467 dimension u(3),v(3),w(3)
4468 w(1)=u(2)*v(3)-u(3)*v(2)
4469 w(2)=-u(1)*v(3)+u(3)*v(1)
4470 w(3)=u(1)*v(2)-u(2)*v(1)
4473 C-----------------------------------------------------------------------------
4474 subroutine unormderiv(u,ugrad,unorm,ungrad)
4475 C This subroutine computes the derivatives of a normalized vector u, given
4476 C the derivatives computed without normalization conditions, ugrad. Returns
4479 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4480 double precision vec(3)
4481 double precision scalar
4483 c write (2,*) 'ugrad',ugrad
4486 vec(i)=scalar(ugrad(1,i),u(1))
4488 c write (2,*) 'vec',vec
4491 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4494 c write (2,*) 'ungrad',ungrad
4497 C-----------------------------------------------------------------------------
4498 subroutine escp(evdw2,evdw2_14)
4500 C This subroutine calculates the excluded-volume interaction energy between
4501 C peptide-group centers and side chains and its gradient in virtual-bond and
4502 C side-chain vectors.
4504 implicit real*8 (a-h,o-z)
4505 include 'DIMENSIONS'
4506 include 'DIMENSIONS.ZSCOPT'
4507 include 'COMMON.GEO'
4508 include 'COMMON.VAR'
4509 include 'COMMON.LOCAL'
4510 include 'COMMON.CHAIN'
4511 include 'COMMON.DERIV'
4512 include 'COMMON.INTERACT'
4513 include 'COMMON.FFIELD'
4514 include 'COMMON.IOUNITS'
4518 cd print '(a)','Enter ESCP'
4519 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4520 c & ' scal14',scal14
4521 do i=iatscp_s,iatscp_e
4523 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4524 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4525 if (iteli.eq.0) goto 1225
4526 xi=0.5D0*(c(1,i)+c(1,i+1))
4527 yi=0.5D0*(c(2,i)+c(2,i+1))
4528 zi=0.5D0*(c(3,i)+c(3,i+1))
4530 do iint=1,nscp_gr(i)
4532 do j=iscpstart(i,iint),iscpend(i,iint)
4534 C Uncomment following three lines for SC-p interactions
4538 C Uncomment following three lines for Ca-p interactions
4542 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4544 e1=fac*fac*aad(itypj,iteli)
4545 e2=fac*bad(itypj,iteli)
4546 if (iabs(j-i) .le. 2) then
4549 evdw2_14=evdw2_14+e1+e2
4552 c write (iout,*) i,j,evdwij
4556 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4558 fac=-(evdwij+e1)*rrij
4563 cd write (iout,*) 'j<i'
4564 C Uncomment following three lines for SC-p interactions
4566 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4569 cd write (iout,*) 'j>i'
4572 C Uncomment following line for SC-p interactions
4573 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4577 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4581 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4582 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4585 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4595 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4596 gradx_scp(j,i)=expon*gradx_scp(j,i)
4599 C******************************************************************************
4603 C To save time the factor EXPON has been extracted from ALL components
4604 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4607 C******************************************************************************
4610 C--------------------------------------------------------------------------
4611 subroutine edis(ehpb)
4613 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4615 implicit real*8 (a-h,o-z)
4616 include 'DIMENSIONS'
4617 include 'COMMON.SBRIDGE'
4618 include 'COMMON.CHAIN'
4619 include 'COMMON.DERIV'
4620 include 'COMMON.VAR'
4621 include 'COMMON.INTERACT'
4622 include 'COMMON.IOUNITS'
4625 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4626 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4627 if (link_end.eq.0) return
4628 do i=link_start,link_end
4629 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4630 C CA-CA distance used in regularization of structure.
4633 C iii and jjj point to the residues for which the distance is assigned.
4634 if (ii.gt.nres) then
4641 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4642 c & dhpb(i),dhpb1(i),forcon(i)
4643 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4644 C distance and angle dependent SS bond potential.
4645 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4646 call ssbond_ene(iii,jjj,eij)
4648 cd write (iout,*) "eij",eij
4649 else if (ii.gt.nres .and. jj.gt.nres) then
4650 c Restraints from contact prediction
4652 if (dhpb1(i).gt.0.0d0) then
4653 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4654 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4655 c write (iout,*) "beta nmr",
4656 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4660 C Get the force constant corresponding to this distance.
4662 C Calculate the contribution to energy.
4663 ehpb=ehpb+waga*rdis*rdis
4664 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4666 C Evaluate gradient.
4671 ggg(j)=fac*(c(j,jj)-c(j,ii))
4674 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4675 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4678 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4679 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4682 C Calculate the distance between the two points and its difference from the
4685 if (dhpb1(i).gt.0.0d0) then
4686 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4687 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4688 c write (iout,*) "alph nmr",
4689 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4692 C Get the force constant corresponding to this distance.
4694 C Calculate the contribution to energy.
4695 ehpb=ehpb+waga*rdis*rdis
4696 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4698 C Evaluate gradient.
4702 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4703 cd & ' waga=',waga,' fac=',fac
4705 ggg(j)=fac*(c(j,jj)-c(j,ii))
4707 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4708 C If this is a SC-SC distance, we need to calculate the contributions to the
4709 C Cartesian gradient in the SC vectors (ghpbx).
4712 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4713 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4717 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4718 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4725 C--------------------------------------------------------------------------
4726 subroutine ssbond_ene(i,j,eij)
4728 C Calculate the distance and angle dependent SS-bond potential energy
4729 C using a free-energy function derived based on RHF/6-31G** ab initio
4730 C calculations of diethyl disulfide.
4732 C A. Liwo and U. Kozlowska, 11/24/03
4734 implicit real*8 (a-h,o-z)
4735 include 'DIMENSIONS'
4736 include 'DIMENSIONS.ZSCOPT'
4737 include 'COMMON.SBRIDGE'
4738 include 'COMMON.CHAIN'
4739 include 'COMMON.DERIV'
4740 include 'COMMON.LOCAL'
4741 include 'COMMON.INTERACT'
4742 include 'COMMON.VAR'
4743 include 'COMMON.IOUNITS'
4744 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4749 dxi=dc_norm(1,nres+i)
4750 dyi=dc_norm(2,nres+i)
4751 dzi=dc_norm(3,nres+i)
4752 dsci_inv=dsc_inv(itypi)
4754 dscj_inv=dsc_inv(itypj)
4758 dxj=dc_norm(1,nres+j)
4759 dyj=dc_norm(2,nres+j)
4760 dzj=dc_norm(3,nres+j)
4761 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4766 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4767 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4768 om12=dxi*dxj+dyi*dyj+dzi*dzj
4770 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4771 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4777 deltat12=om2-om1+2.0d0
4779 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4780 & +akct*deltad*deltat12
4781 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4782 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4783 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4784 c & " deltat12",deltat12," eij",eij
4785 ed=2*akcm*deltad+akct*deltat12
4787 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4788 eom1=-2*akth*deltat1-pom1-om2*pom2
4789 eom2= 2*akth*deltat2+pom1-om1*pom2
4792 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4795 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4796 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4797 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4798 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4801 C Calculate the components of the gradient in DC and X
4805 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4810 C--------------------------------------------------------------------------
4811 subroutine ebond(estr)
4813 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4815 implicit real*8 (a-h,o-z)
4816 include 'DIMENSIONS'
4817 include 'DIMENSIONS.ZSCOPT'
4818 include 'COMMON.LOCAL'
4819 include 'COMMON.GEO'
4820 include 'COMMON.INTERACT'
4821 include 'COMMON.DERIV'
4822 include 'COMMON.VAR'
4823 include 'COMMON.CHAIN'
4824 include 'COMMON.IOUNITS'
4825 include 'COMMON.NAMES'
4826 include 'COMMON.FFIELD'
4827 include 'COMMON.CONTROL'
4828 double precision u(3),ud(3)
4831 diff = vbld(i)-vbldp0
4832 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4835 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4840 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4847 diff=vbld(i+nres)-vbldsc0(1,iti)
4849 write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4850 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4852 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4853 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4854 >>>>>>> e183793... Added src_MD-M-newcorr (Adasko's source) and src-NEWSC of WHAM (with Momo's SCSC potentials)
4855 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4857 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4861 diff=vbld(i+nres)-vbldsc0(j,iti)
4862 ud(j)=aksc(j,iti)*diff
4863 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4877 uprod2=uprod2*u(k)*u(k)
4881 usumsqder=usumsqder+ud(j)*uprod2
4884 write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4885 & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4887 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4888 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4889 >>>>>>> e183793... Added src_MD-M-newcorr (Adasko's source) and src-NEWSC of WHAM (with Momo's SCSC potentials)
4890 estr=estr+uprod/usum
4892 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4900 C--------------------------------------------------------------------------
4901 subroutine ebend(etheta)
4903 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4904 C angles gamma and its derivatives in consecutive thetas and gammas.
4906 implicit real*8 (a-h,o-z)
4907 include 'DIMENSIONS'
4908 include 'DIMENSIONS.ZSCOPT'
4909 include 'COMMON.LOCAL'
4910 include 'COMMON.GEO'
4911 include 'COMMON.INTERACT'
4912 include 'COMMON.DERIV'
4913 include 'COMMON.VAR'
4914 include 'COMMON.CHAIN'
4915 include 'COMMON.IOUNITS'
4916 include 'COMMON.NAMES'
4917 include 'COMMON.FFIELD'
4918 common /calcthet/ term1,term2,termm,diffak,ratak,
4919 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4920 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4921 double precision y(2),z(2)
4923 time11=dexp(-2*time)
4926 c write (iout,*) "nres",nres
4927 c write (*,'(a,i2)') 'EBEND ICG=',icg
4928 c write (iout,*) ithet_start,ithet_end
4929 do i=ithet_start,ithet_end
4930 C Zero the energy function and its derivative at 0 or pi.
4931 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4933 c if (i.gt.ithet_start .and.
4934 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
4935 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
4943 c if (i.lt.nres .and. itel(i).ne.0) then
4955 call proc_proc(phii,icrc)
4956 if (icrc.eq.1) phii=150.0
4970 call proc_proc(phii1,icrc)
4971 if (icrc.eq.1) phii1=150.0
4983 C Calculate the "mean" value of theta from the part of the distribution
4984 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4985 C In following comments this theta will be referred to as t_c.
4986 thet_pred_mean=0.0d0
4990 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4992 c write (iout,*) "thet_pred_mean",thet_pred_mean
4993 dthett=thet_pred_mean*ssd
4994 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4995 c write (iout,*) "thet_pred_mean",thet_pred_mean
4996 C Derivatives of the "mean" values in gamma1 and gamma2.
4997 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4998 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4999 if (theta(i).gt.pi-delta) then
5000 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5002 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5003 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5004 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5006 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5008 else if (theta(i).lt.delta) then
5009 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5010 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5011 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5013 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5014 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5017 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5020 etheta=etheta+ethetai
5021 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
5022 c & rad2deg*phii,rad2deg*phii1,ethetai
5023 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5024 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5025 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5028 C Ufff.... We've done all this!!!
5031 C---------------------------------------------------------------------------
5032 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5034 implicit real*8 (a-h,o-z)
5035 include 'DIMENSIONS'
5036 include 'COMMON.LOCAL'
5037 include 'COMMON.IOUNITS'
5038 common /calcthet/ term1,term2,termm,diffak,ratak,
5039 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5040 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5041 C Calculate the contributions to both Gaussian lobes.
5042 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5043 C The "polynomial part" of the "standard deviation" of this part of
5047 sig=sig*thet_pred_mean+polthet(j,it)
5049 C Derivative of the "interior part" of the "standard deviation of the"
5050 C gamma-dependent Gaussian lobe in t_c.
5051 sigtc=3*polthet(3,it)
5053 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5056 C Set the parameters of both Gaussian lobes of the distribution.
5057 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5058 fac=sig*sig+sigc0(it)
5061 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5062 sigsqtc=-4.0D0*sigcsq*sigtc
5063 c print *,i,sig,sigtc,sigsqtc
5064 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5065 sigtc=-sigtc/(fac*fac)
5066 C Following variable is sigma(t_c)**(-2)
5067 sigcsq=sigcsq*sigcsq
5069 sig0inv=1.0D0/sig0i**2
5070 delthec=thetai-thet_pred_mean
5071 delthe0=thetai-theta0i
5072 term1=-0.5D0*sigcsq*delthec*delthec
5073 term2=-0.5D0*sig0inv*delthe0*delthe0
5074 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5075 C NaNs in taking the logarithm. We extract the largest exponent which is added
5076 C to the energy (this being the log of the distribution) at the end of energy
5077 C term evaluation for this virtual-bond angle.
5078 if (term1.gt.term2) then
5080 term2=dexp(term2-termm)
5084 term1=dexp(term1-termm)
5087 C The ratio between the gamma-independent and gamma-dependent lobes of
5088 C the distribution is a Gaussian function of thet_pred_mean too.
5089 diffak=gthet(2,it)-thet_pred_mean
5090 ratak=diffak/gthet(3,it)**2
5091 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5092 C Let's differentiate it in thet_pred_mean NOW.
5094 C Now put together the distribution terms to make complete distribution.
5095 termexp=term1+ak*term2
5096 termpre=sigc+ak*sig0i
5097 C Contribution of the bending energy from this theta is just the -log of
5098 C the sum of the contributions from the two lobes and the pre-exponential
5099 C factor. Simple enough, isn't it?
5100 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5101 C NOW the derivatives!!!
5102 C 6/6/97 Take into account the deformation.
5103 E_theta=(delthec*sigcsq*term1
5104 & +ak*delthe0*sig0inv*term2)/termexp
5105 E_tc=((sigtc+aktc*sig0i)/termpre
5106 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5107 & aktc*term2)/termexp)
5110 c-----------------------------------------------------------------------------
5111 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5112 implicit real*8 (a-h,o-z)
5113 include 'DIMENSIONS'
5114 include 'COMMON.LOCAL'
5115 include 'COMMON.IOUNITS'
5116 common /calcthet/ term1,term2,termm,diffak,ratak,
5117 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5118 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5119 delthec=thetai-thet_pred_mean
5120 delthe0=thetai-theta0i
5121 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5122 t3 = thetai-thet_pred_mean
5126 t14 = t12+t6*sigsqtc
5128 t21 = thetai-theta0i
5134 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5135 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5136 & *(-t12*t9-ak*sig0inv*t27)
5140 C--------------------------------------------------------------------------
5141 subroutine ebend(etheta)
5143 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5144 C angles gamma and its derivatives in consecutive thetas and gammas.
5145 C ab initio-derived potentials from
5146 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5148 implicit real*8 (a-h,o-z)
5149 include 'DIMENSIONS'
5150 include 'DIMENSIONS.ZSCOPT'
5151 include 'COMMON.LOCAL'
5152 include 'COMMON.GEO'
5153 include 'COMMON.INTERACT'
5154 include 'COMMON.DERIV'
5155 include 'COMMON.VAR'
5156 include 'COMMON.CHAIN'
5157 include 'COMMON.IOUNITS'
5158 include 'COMMON.NAMES'
5159 include 'COMMON.FFIELD'
5160 include 'COMMON.CONTROL'
5161 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5162 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5163 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5164 & sinph1ph2(maxdouble,maxdouble)
5165 logical lprn /.false./, lprn1 /.false./
5167 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5168 do i=ithet_start,ithet_end
5172 theti2=0.5d0*theta(i)
5173 ityp2=ithetyp(itype(i-1))
5175 coskt(k)=dcos(k*theti2)
5176 sinkt(k)=dsin(k*theti2)
5181 if (phii.ne.phii) phii=150.0
5185 ityp1=ithetyp(itype(i-2))
5187 cosph1(k)=dcos(k*phii)
5188 sinph1(k)=dsin(k*phii)
5201 if (phii1.ne.phii1) phii1=150.0
5206 ityp3=ithetyp(itype(i))
5208 cosph2(k)=dcos(k*phii1)
5209 sinph2(k)=dsin(k*phii1)
5219 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5220 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5222 ethetai=aa0thet(ityp1,ityp2,ityp3)
5225 ccl=cosph1(l)*cosph2(k-l)
5226 ssl=sinph1(l)*sinph2(k-l)
5227 scl=sinph1(l)*cosph2(k-l)
5228 csl=cosph1(l)*sinph2(k-l)
5229 cosph1ph2(l,k)=ccl-ssl
5230 cosph1ph2(k,l)=ccl+ssl
5231 sinph1ph2(l,k)=scl+csl
5232 sinph1ph2(k,l)=scl-csl
5236 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5237 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5238 write (iout,*) "coskt and sinkt"
5240 write (iout,*) k,coskt(k),sinkt(k)
5244 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
5245 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
5248 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
5249 & " ethetai",ethetai
5252 write (iout,*) "cosph and sinph"
5254 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5256 write (iout,*) "cosph1ph2 and sinph2ph2"
5259 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5260 & sinph1ph2(l,k),sinph1ph2(k,l)
5263 write(iout,*) "ethetai",ethetai
5267 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
5268 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
5269 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
5270 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
5271 ethetai=ethetai+sinkt(m)*aux
5272 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5273 dephii=dephii+k*sinkt(m)*(
5274 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
5275 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
5276 dephii1=dephii1+k*sinkt(m)*(
5277 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
5278 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
5280 & write (iout,*) "m",m," k",k," bbthet",
5281 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
5282 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
5283 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
5284 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5288 & write(iout,*) "ethetai",ethetai
5292 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5293 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
5294 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5295 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
5296 ethetai=ethetai+sinkt(m)*aux
5297 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5298 dephii=dephii+l*sinkt(m)*(
5299 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
5300 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5301 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5302 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5303 dephii1=dephii1+(k-l)*sinkt(m)*(
5304 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5305 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5306 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5307 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5309 write (iout,*) "m",m," k",k," l",l," ffthet",
5310 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5311 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5312 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5313 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5314 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5315 & cosph1ph2(k,l)*sinkt(m),
5316 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5322 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5323 & i,theta(i)*rad2deg,phii*rad2deg,
5324 & phii1*rad2deg,ethetai
5325 etheta=etheta+ethetai
5326 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5327 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5328 gloc(nphi+i-2,icg)=wang*dethetai
5334 c-----------------------------------------------------------------------------
5335 subroutine esc(escloc)
5336 C Calculate the local energy of a side chain and its derivatives in the
5337 C corresponding virtual-bond valence angles THETA and the spherical angles
5339 implicit real*8 (a-h,o-z)
5340 include 'DIMENSIONS'
5341 include 'DIMENSIONS.ZSCOPT'
5342 include 'COMMON.GEO'
5343 include 'COMMON.LOCAL'
5344 include 'COMMON.VAR'
5345 include 'COMMON.INTERACT'
5346 include 'COMMON.DERIV'
5347 include 'COMMON.CHAIN'
5348 include 'COMMON.IOUNITS'
5349 include 'COMMON.NAMES'
5350 include 'COMMON.FFIELD'
5351 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5352 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5353 common /sccalc/ time11,time12,time112,theti,it,nlobit
5356 c write (iout,'(a)') 'ESC'
5357 do i=loc_start,loc_end
5359 if (it.eq.10) goto 1
5361 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5362 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5363 theti=theta(i+1)-pipol
5367 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5369 if (x(2).gt.pi-delta) then
5373 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5375 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5376 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5378 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5379 & ddersc0(1),dersc(1))
5380 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5381 & ddersc0(3),dersc(3))
5383 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5385 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5386 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5387 & dersc0(2),esclocbi,dersc02)
5388 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5390 call splinthet(x(2),0.5d0*delta,ss,ssd)
5395 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5397 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5398 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5400 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5402 c write (iout,*) escloci
5403 else if (x(2).lt.delta) then
5407 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5409 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5410 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5412 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5413 & ddersc0(1),dersc(1))
5414 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5415 & ddersc0(3),dersc(3))
5417 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5419 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5420 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5421 & dersc0(2),esclocbi,dersc02)
5422 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5427 call splinthet(x(2),0.5d0*delta,ss,ssd)
5429 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5431 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5432 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5434 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5435 c write (iout,*) escloci
5437 call enesc(x,escloci,dersc,ddummy,.false.)
5440 escloc=escloc+escloci
5441 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5443 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5445 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5446 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5451 C---------------------------------------------------------------------------
5452 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5453 implicit real*8 (a-h,o-z)
5454 include 'DIMENSIONS'
5455 include 'COMMON.GEO'
5456 include 'COMMON.LOCAL'
5457 include 'COMMON.IOUNITS'
5458 common /sccalc/ time11,time12,time112,theti,it,nlobit
5459 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5460 double precision contr(maxlob,-1:1)
5462 c write (iout,*) 'it=',it,' nlobit=',nlobit
5466 if (mixed) ddersc(j)=0.0d0
5470 C Because of periodicity of the dependence of the SC energy in omega we have
5471 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5472 C To avoid underflows, first compute & store the exponents.
5480 z(k)=x(k)-censc(k,j,it)
5485 Axk=Axk+gaussc(l,k,j,it)*z(l)
5491 expfac=expfac+Ax(k,j,iii)*z(k)
5499 C As in the case of ebend, we want to avoid underflows in exponentiation and
5500 C subsequent NaNs and INFs in energy calculation.
5501 C Find the largest exponent
5505 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5509 cd print *,'it=',it,' emin=',emin
5511 C Compute the contribution to SC energy and derivatives
5515 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5516 cd print *,'j=',j,' expfac=',expfac
5517 escloc_i=escloc_i+expfac
5519 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5523 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5524 & +gaussc(k,2,j,it))*expfac
5531 dersc(1)=dersc(1)/cos(theti)**2
5532 ddersc(1)=ddersc(1)/cos(theti)**2
5535 escloci=-(dlog(escloc_i)-emin)
5537 dersc(j)=dersc(j)/escloc_i
5541 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5546 C------------------------------------------------------------------------------
5547 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5548 implicit real*8 (a-h,o-z)
5549 include 'DIMENSIONS'
5550 include 'COMMON.GEO'
5551 include 'COMMON.LOCAL'
5552 include 'COMMON.IOUNITS'
5553 common /sccalc/ time11,time12,time112,theti,it,nlobit
5554 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5555 double precision contr(maxlob)
5566 z(k)=x(k)-censc(k,j,it)
5572 Axk=Axk+gaussc(l,k,j,it)*z(l)
5578 expfac=expfac+Ax(k,j)*z(k)
5583 C As in the case of ebend, we want to avoid underflows in exponentiation and
5584 C subsequent NaNs and INFs in energy calculation.
5585 C Find the largest exponent
5588 if (emin.gt.contr(j)) emin=contr(j)
5592 C Compute the contribution to SC energy and derivatives
5596 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5597 escloc_i=escloc_i+expfac
5599 dersc(k)=dersc(k)+Ax(k,j)*expfac
5601 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5602 & +gaussc(1,2,j,it))*expfac
5606 dersc(1)=dersc(1)/cos(theti)**2
5607 dersc12=dersc12/cos(theti)**2
5608 escloci=-(dlog(escloc_i)-emin)
5610 dersc(j)=dersc(j)/escloc_i
5612 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5616 c----------------------------------------------------------------------------------
5617 subroutine esc(escloc)
5618 C Calculate the local energy of a side chain and its derivatives in the
5619 C corresponding virtual-bond valence angles THETA and the spherical angles
5620 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5621 C added by Urszula Kozlowska. 07/11/2007
5623 implicit real*8 (a-h,o-z)
5624 include 'DIMENSIONS'
5625 include 'DIMENSIONS.ZSCOPT'
5626 include 'COMMON.GEO'
5627 include 'COMMON.LOCAL'
5628 include 'COMMON.VAR'
5629 include 'COMMON.SCROT'
5630 include 'COMMON.INTERACT'
5631 include 'COMMON.DERIV'
5632 include 'COMMON.CHAIN'
5633 include 'COMMON.IOUNITS'
5634 include 'COMMON.NAMES'
5635 include 'COMMON.FFIELD'
5636 include 'COMMON.CONTROL'
5637 include 'COMMON.VECTORS'
5638 double precision x_prime(3),y_prime(3),z_prime(3)
5639 & , sumene,dsc_i,dp2_i,x(65),
5640 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5641 & de_dxx,de_dyy,de_dzz,de_dt
5642 double precision s1_t,s1_6_t,s2_t,s2_6_t
5644 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5645 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5646 & dt_dCi(3),dt_dCi1(3)
5647 common /sccalc/ time11,time12,time112,theti,it,nlobit
5650 do i=loc_start,loc_end
5651 costtab(i+1) =dcos(theta(i+1))
5652 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5653 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5654 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5655 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5656 cosfac=dsqrt(cosfac2)
5657 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5658 sinfac=dsqrt(sinfac2)
5660 if (it.eq.10) goto 1
5662 C Compute the axes of tghe local cartesian coordinates system; store in
5663 c x_prime, y_prime and z_prime
5670 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5671 C & dc_norm(3,i+nres)
5673 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5674 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5677 z_prime(j) = -uz(j,i-1)
5680 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5681 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5682 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5683 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5684 c & " xy",scalar(x_prime(1),y_prime(1)),
5685 c & " xz",scalar(x_prime(1),z_prime(1)),
5686 c & " yy",scalar(y_prime(1),y_prime(1)),
5687 c & " yz",scalar(y_prime(1),z_prime(1)),
5688 c & " zz",scalar(z_prime(1),z_prime(1))
5690 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5691 C to local coordinate system. Store in xx, yy, zz.
5697 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5698 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5699 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5706 C Compute the energy of the ith side cbain
5708 c write (2,*) "xx",xx," yy",yy," zz",zz
5711 x(j) = sc_parmin(j,it)
5714 Cc diagnostics - remove later
5716 yy1 = dsin(alph(2))*dcos(omeg(2))
5717 zz1 = -dsin(alph(2))*dsin(omeg(2))
5718 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5719 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5721 C," --- ", xx_w,yy_w,zz_w
5724 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5725 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5727 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5728 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5730 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5731 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5732 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5733 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5734 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5736 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5737 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5738 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5739 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5740 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5742 dsc_i = 0.743d0+x(61)
5744 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5745 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5746 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5747 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5748 s1=(1+x(63))/(0.1d0 + dscp1)
5749 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5750 s2=(1+x(65))/(0.1d0 + dscp2)
5751 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5752 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5753 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5754 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5756 c & dscp1,dscp2,sumene
5757 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5758 escloc = escloc + sumene
5759 c write (2,*) "escloc",escloc
5760 if (.not. calc_grad) goto 1
5763 C This section to check the numerical derivatives of the energy of ith side
5764 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5765 C #define DEBUG in the code to turn it on.
5767 write (2,*) "sumene =",sumene
5771 write (2,*) xx,yy,zz
5772 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5773 de_dxx_num=(sumenep-sumene)/aincr
5775 write (2,*) "xx+ sumene from enesc=",sumenep
5778 write (2,*) xx,yy,zz
5779 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5780 de_dyy_num=(sumenep-sumene)/aincr
5782 write (2,*) "yy+ sumene from enesc=",sumenep
5785 write (2,*) xx,yy,zz
5786 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5787 de_dzz_num=(sumenep-sumene)/aincr
5789 write (2,*) "zz+ sumene from enesc=",sumenep
5790 costsave=cost2tab(i+1)
5791 sintsave=sint2tab(i+1)
5792 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5793 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5794 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5795 de_dt_num=(sumenep-sumene)/aincr
5796 write (2,*) " t+ sumene from enesc=",sumenep
5797 cost2tab(i+1)=costsave
5798 sint2tab(i+1)=sintsave
5799 C End of diagnostics section.
5802 C Compute the gradient of esc
5804 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5805 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5806 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5807 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5808 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5809 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5810 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5811 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5812 pom1=(sumene3*sint2tab(i+1)+sumene1)
5813 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5814 pom2=(sumene4*cost2tab(i+1)+sumene2)
5815 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5816 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5817 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5818 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5820 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5821 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5822 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5824 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5825 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5826 & +(pom1+pom2)*pom_dx
5828 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5831 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5832 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5833 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5835 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5836 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5837 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5838 & +x(59)*zz**2 +x(60)*xx*zz
5839 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5840 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5841 & +(pom1-pom2)*pom_dy
5843 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5846 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5847 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5848 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5849 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5850 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5851 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5852 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5853 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5855 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5858 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5859 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5860 & +pom1*pom_dt1+pom2*pom_dt2
5862 write(2,*), "de_dt = ", de_dt,de_dt_num
5866 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5867 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5868 cosfac2xx=cosfac2*xx
5869 sinfac2yy=sinfac2*yy
5871 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5873 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5875 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5876 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5877 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5878 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5879 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5880 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5881 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5882 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5883 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5884 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5888 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5889 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5892 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5893 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5894 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5896 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5897 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5901 dXX_Ctab(k,i)=dXX_Ci(k)
5902 dXX_C1tab(k,i)=dXX_Ci1(k)
5903 dYY_Ctab(k,i)=dYY_Ci(k)
5904 dYY_C1tab(k,i)=dYY_Ci1(k)
5905 dZZ_Ctab(k,i)=dZZ_Ci(k)
5906 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5907 dXX_XYZtab(k,i)=dXX_XYZ(k)
5908 dYY_XYZtab(k,i)=dYY_XYZ(k)
5909 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5913 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5914 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5915 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5916 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5917 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5919 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5920 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5921 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5922 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5923 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5924 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5925 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5926 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5928 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5929 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5931 C to check gradient call subroutine check_grad
5938 c------------------------------------------------------------------------------
5939 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5941 C This procedure calculates two-body contact function g(rij) and its derivative:
5944 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5947 C where x=(rij-r0ij)/delta
5949 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5952 double precision rij,r0ij,eps0ij,fcont,fprimcont
5953 double precision x,x2,x4,delta
5957 if (x.lt.-1.0D0) then
5960 else if (x.le.1.0D0) then
5963 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5964 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5971 c------------------------------------------------------------------------------
5972 subroutine splinthet(theti,delta,ss,ssder)
5973 implicit real*8 (a-h,o-z)
5974 include 'DIMENSIONS'
5975 include 'DIMENSIONS.ZSCOPT'
5976 include 'COMMON.VAR'
5977 include 'COMMON.GEO'
5980 if (theti.gt.pipol) then
5981 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5983 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5988 c------------------------------------------------------------------------------
5989 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5991 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5992 double precision ksi,ksi2,ksi3,a1,a2,a3
5993 a1=fprim0*delta/(f1-f0)
5999 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6000 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6003 c------------------------------------------------------------------------------
6004 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6006 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6007 double precision ksi,ksi2,ksi3,a1,a2,a3
6012 a2=3*(f1x-f0x)-2*fprim0x*delta
6013 a3=fprim0x*delta-2*(f1x-f0x)
6014 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6017 C-----------------------------------------------------------------------------
6019 C-----------------------------------------------------------------------------
6020 subroutine etor(etors,edihcnstr,fact)
6021 implicit real*8 (a-h,o-z)
6022 include 'DIMENSIONS'
6023 include 'DIMENSIONS.ZSCOPT'
6024 include 'COMMON.VAR'
6025 include 'COMMON.GEO'
6026 include 'COMMON.LOCAL'
6027 include 'COMMON.TORSION'
6028 include 'COMMON.INTERACT'
6029 include 'COMMON.DERIV'
6030 include 'COMMON.CHAIN'
6031 include 'COMMON.NAMES'
6032 include 'COMMON.IOUNITS'
6033 include 'COMMON.FFIELD'
6034 include 'COMMON.TORCNSTR'
6036 C Set lprn=.true. for debugging
6040 do i=iphi_start,iphi_end
6041 itori=itortyp(itype(i-2))
6042 itori1=itortyp(itype(i-1))
6045 C Proline-Proline pair is a special case...
6046 if (itori.eq.3 .and. itori1.eq.3) then
6047 if (phii.gt.-dwapi3) then
6049 fac=1.0D0/(1.0D0-cosphi)
6050 etorsi=v1(1,3,3)*fac
6051 etorsi=etorsi+etorsi
6052 etors=etors+etorsi-v1(1,3,3)
6053 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6056 v1ij=v1(j+1,itori,itori1)
6057 v2ij=v2(j+1,itori,itori1)
6060 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6061 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6065 v1ij=v1(j,itori,itori1)
6066 v2ij=v2(j,itori,itori1)
6069 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6070 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6074 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6075 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6076 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6077 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6078 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6080 ! 6/20/98 - dihedral angle constraints
6083 itori=idih_constr(i)
6086 if (difi.gt.drange(i)) then
6088 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6089 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6090 else if (difi.lt.-drange(i)) then
6092 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6093 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6095 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6096 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6098 ! write (iout,*) 'edihcnstr',edihcnstr
6101 c------------------------------------------------------------------------------
6103 subroutine etor(etors,edihcnstr,fact)
6104 implicit real*8 (a-h,o-z)
6105 include 'DIMENSIONS'
6106 include 'DIMENSIONS.ZSCOPT'
6107 include 'COMMON.VAR'
6108 include 'COMMON.GEO'
6109 include 'COMMON.LOCAL'
6110 include 'COMMON.TORSION'
6111 include 'COMMON.INTERACT'
6112 include 'COMMON.DERIV'
6113 include 'COMMON.CHAIN'
6114 include 'COMMON.NAMES'
6115 include 'COMMON.IOUNITS'
6116 include 'COMMON.FFIELD'
6117 include 'COMMON.TORCNSTR'
6119 C Set lprn=.true. for debugging
6123 do i=iphi_start,iphi_end
6124 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6125 itori=itortyp(itype(i-2))
6126 itori1=itortyp(itype(i-1))
6129 C Regular cosine and sine terms
6130 do j=1,nterm(itori,itori1)
6131 v1ij=v1(j,itori,itori1)
6132 v2ij=v2(j,itori,itori1)
6135 etors=etors+v1ij*cosphi+v2ij*sinphi
6136 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6140 C E = SUM ----------------------------------- - v1
6141 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6143 cosphi=dcos(0.5d0*phii)
6144 sinphi=dsin(0.5d0*phii)
6145 do j=1,nlor(itori,itori1)
6146 vl1ij=vlor1(j,itori,itori1)
6147 vl2ij=vlor2(j,itori,itori1)
6148 vl3ij=vlor3(j,itori,itori1)
6149 pom=vl2ij*cosphi+vl3ij*sinphi
6150 pom1=1.0d0/(pom*pom+1.0d0)
6151 etors=etors+vl1ij*pom1
6153 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6155 C Subtract the constant term
6156 etors=etors-v0(itori,itori1)
6158 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6159 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6160 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6161 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
6162 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6165 ! 6/20/98 - dihedral angle constraints
6168 itori=idih_constr(i)
6170 difi=pinorm(phii-phi0(i))
6172 if (difi.gt.drange(i)) then
6174 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6175 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6176 edihi=0.25d0*ftors*difi**4
6177 else if (difi.lt.-drange(i)) then
6179 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6180 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6181 edihi=0.25d0*ftors*difi**4
6185 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
6187 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6188 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6190 ! write (iout,*) 'edihcnstr',edihcnstr
6193 c----------------------------------------------------------------------------
6194 subroutine etor_d(etors_d,fact2)
6195 C 6/23/01 Compute double torsional energy
6196 implicit real*8 (a-h,o-z)
6197 include 'DIMENSIONS'
6198 include 'DIMENSIONS.ZSCOPT'
6199 include 'COMMON.VAR'
6200 include 'COMMON.GEO'
6201 include 'COMMON.LOCAL'
6202 include 'COMMON.TORSION'
6203 include 'COMMON.INTERACT'
6204 include 'COMMON.DERIV'
6205 include 'COMMON.CHAIN'
6206 include 'COMMON.NAMES'
6207 include 'COMMON.IOUNITS'
6208 include 'COMMON.FFIELD'
6209 include 'COMMON.TORCNSTR'
6211 C Set lprn=.true. for debugging
6215 do i=iphi_start,iphi_end-1
6216 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6218 itori=itortyp(itype(i-2))
6219 itori1=itortyp(itype(i-1))
6220 itori2=itortyp(itype(i))
6225 C Regular cosine and sine terms
6226 do j=1,ntermd_1(itori,itori1,itori2)
6227 v1cij=v1c(1,j,itori,itori1,itori2)
6228 v1sij=v1s(1,j,itori,itori1,itori2)
6229 v2cij=v1c(2,j,itori,itori1,itori2)
6230 v2sij=v1s(2,j,itori,itori1,itori2)
6231 cosphi1=dcos(j*phii)
6232 sinphi1=dsin(j*phii)
6233 cosphi2=dcos(j*phii1)
6234 sinphi2=dsin(j*phii1)
6235 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6236 & v2cij*cosphi2+v2sij*sinphi2
6237 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6238 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6240 do k=2,ntermd_2(itori,itori1,itori2)
6242 v1cdij = v2c(k,l,itori,itori1,itori2)
6243 v2cdij = v2c(l,k,itori,itori1,itori2)
6244 v1sdij = v2s(k,l,itori,itori1,itori2)
6245 v2sdij = v2s(l,k,itori,itori1,itori2)
6246 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6247 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6248 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6249 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6250 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6251 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6252 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6253 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6254 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6255 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6258 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
6259 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
6265 c------------------------------------------------------------------------------
6266 subroutine eback_sc_corr(esccor)
6267 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6268 c conformational states; temporarily implemented as differences
6269 c between UNRES torsional potentials (dependent on three types of
6270 c residues) and the torsional potentials dependent on all 20 types
6271 c of residues computed from AM1 energy surfaces of terminally-blocked
6272 c amino-acid residues.
6273 implicit real*8 (a-h,o-z)
6274 include 'DIMENSIONS'
6275 include 'DIMENSIONS.ZSCOPT'
6276 include 'COMMON.VAR'
6277 include 'COMMON.GEO'
6278 include 'COMMON.LOCAL'
6279 include 'COMMON.TORSION'
6280 include 'COMMON.SCCOR'
6281 include 'COMMON.INTERACT'
6282 include 'COMMON.DERIV'
6283 include 'COMMON.CHAIN'
6284 include 'COMMON.NAMES'
6285 include 'COMMON.IOUNITS'
6286 include 'COMMON.FFIELD'
6287 include 'COMMON.CONTROL'
6289 C Set lprn=.true. for debugging
6292 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
6294 do i=itau_start,itau_end
6296 isccori=isccortyp(itype(i-2))
6297 isccori1=isccortyp(itype(i-1))
6299 cccc Added 9 May 2012
6300 cc Tauangle is torsional engle depending on the value of first digit
6301 c(see comment below)
6302 cc Omicron is flat angle depending on the value of first digit
6303 c(see comment below)
6306 do intertyp=1,3 !intertyp
6307 cc Added 09 May 2012 (Adasko)
6308 cc Intertyp means interaction type of backbone mainchain correlation:
6309 c 1 = SC...Ca...Ca...Ca
6310 c 2 = Ca...Ca...Ca...SC
6311 c 3 = SC...Ca...Ca...SCi
6313 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6314 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6315 & (itype(i-1).eq.21)))
6316 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6317 & .or.(itype(i-2).eq.21)))
6318 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6319 & (itype(i-1).eq.21)))) cycle
6320 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6321 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6323 do j=1,nterm_sccor(isccori,isccori1)
6324 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6325 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6326 cosphi=dcos(j*tauangle(intertyp,i))
6327 sinphi=dsin(j*tauangle(intertyp,i))
6328 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6329 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6331 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6332 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6333 c &gloc_sc(intertyp,i-3,icg)
6335 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6336 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6337 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
6338 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
6339 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6343 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
6347 c------------------------------------------------------------------------------
6348 subroutine multibody(ecorr)
6349 C This subroutine calculates multi-body contributions to energy following
6350 C the idea of Skolnick et al. If side chains I and J make a contact and
6351 C at the same time side chains I+1 and J+1 make a contact, an extra
6352 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6353 implicit real*8 (a-h,o-z)
6354 include 'DIMENSIONS'
6355 include 'COMMON.IOUNITS'
6356 include 'COMMON.DERIV'
6357 include 'COMMON.INTERACT'
6358 include 'COMMON.CONTACTS'
6359 double precision gx(3),gx1(3)
6362 C Set lprn=.true. for debugging
6366 write (iout,'(a)') 'Contact function values:'
6368 write (iout,'(i2,20(1x,i2,f10.5))')
6369 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6384 num_conti=num_cont(i)
6385 num_conti1=num_cont(i1)
6390 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6391 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6392 cd & ' ishift=',ishift
6393 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6394 C The system gains extra energy.
6395 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6396 endif ! j1==j+-ishift
6405 c------------------------------------------------------------------------------
6406 double precision function esccorr(i,j,k,l,jj,kk)
6407 implicit real*8 (a-h,o-z)
6408 include 'DIMENSIONS'
6409 include 'COMMON.IOUNITS'
6410 include 'COMMON.DERIV'
6411 include 'COMMON.INTERACT'
6412 include 'COMMON.CONTACTS'
6413 double precision gx(3),gx1(3)
6418 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6419 C Calculate the multi-body contribution to energy.
6420 C Calculate multi-body contributions to the gradient.
6421 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6422 cd & k,l,(gacont(m,kk,k),m=1,3)
6424 gx(m) =ekl*gacont(m,jj,i)
6425 gx1(m)=eij*gacont(m,kk,k)
6426 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6427 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6428 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6429 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6433 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6438 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6444 c------------------------------------------------------------------------------
6446 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
6447 implicit real*8 (a-h,o-z)
6448 include 'DIMENSIONS'
6449 integer dimen1,dimen2,atom,indx
6450 double precision buffer(dimen1,dimen2)
6451 double precision zapas
6452 common /contacts_hb/ zapas(3,20,maxres,7),
6453 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6454 & num_cont_hb(maxres),jcont_hb(20,maxres)
6455 num_kont=num_cont_hb(atom)
6459 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
6462 buffer(i,indx+22)=facont_hb(i,atom)
6463 buffer(i,indx+23)=ees0p(i,atom)
6464 buffer(i,indx+24)=ees0m(i,atom)
6465 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
6467 buffer(1,indx+26)=dfloat(num_kont)
6470 c------------------------------------------------------------------------------
6471 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
6472 implicit real*8 (a-h,o-z)
6473 include 'DIMENSIONS'
6474 integer dimen1,dimen2,atom,indx
6475 double precision buffer(dimen1,dimen2)
6476 double precision zapas
6477 common /contacts_hb/ zapas(3,20,maxres,7),
6478 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6479 & num_cont_hb(maxres),jcont_hb(20,maxres)
6480 num_kont=buffer(1,indx+26)
6481 num_kont_old=num_cont_hb(atom)
6482 num_cont_hb(atom)=num_kont+num_kont_old
6487 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
6490 facont_hb(ii,atom)=buffer(i,indx+22)
6491 ees0p(ii,atom)=buffer(i,indx+23)
6492 ees0m(ii,atom)=buffer(i,indx+24)
6493 jcont_hb(ii,atom)=buffer(i,indx+25)
6497 c------------------------------------------------------------------------------
6499 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6500 C This subroutine calculates multi-body contributions to hydrogen-bonding
6501 implicit real*8 (a-h,o-z)
6502 include 'DIMENSIONS'
6503 include 'DIMENSIONS.ZSCOPT'
6504 include 'COMMON.IOUNITS'
6506 include 'COMMON.INFO'
6508 include 'COMMON.FFIELD'
6509 include 'COMMON.DERIV'
6510 include 'COMMON.INTERACT'
6511 include 'COMMON.CONTACTS'
6513 parameter (max_cont=maxconts)
6514 parameter (max_dim=2*(8*3+2))
6515 parameter (msglen1=max_cont*max_dim*4)
6516 parameter (msglen2=2*msglen1)
6517 integer source,CorrelType,CorrelID,Error
6518 double precision buffer(max_cont,max_dim)
6520 double precision gx(3),gx1(3)
6523 C Set lprn=.true. for debugging
6528 if (fgProcs.le.1) goto 30
6530 write (iout,'(a)') 'Contact function values:'
6532 write (iout,'(2i3,50(1x,i2,f5.2))')
6533 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6534 & j=1,num_cont_hb(i))
6537 C Caution! Following code assumes that electrostatic interactions concerning
6538 C a given atom are split among at most two processors!
6548 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6551 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6552 if (MyRank.gt.0) then
6553 C Send correlation contributions to the preceding processor
6555 nn=num_cont_hb(iatel_s)
6556 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6557 cd write (iout,*) 'The BUFFER array:'
6559 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6561 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6563 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6564 C Clear the contacts of the atom passed to the neighboring processor
6565 nn=num_cont_hb(iatel_s+1)
6567 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6569 num_cont_hb(iatel_s)=0
6571 cd write (iout,*) 'Processor ',MyID,MyRank,
6572 cd & ' is sending correlation contribution to processor',MyID-1,
6573 cd & ' msglen=',msglen
6574 cd write (*,*) 'Processor ',MyID,MyRank,
6575 cd & ' is sending correlation contribution to processor',MyID-1,
6576 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6577 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6578 cd write (iout,*) 'Processor ',MyID,
6579 cd & ' has sent correlation contribution to processor',MyID-1,
6580 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6581 cd write (*,*) 'Processor ',MyID,
6582 cd & ' has sent correlation contribution to processor',MyID-1,
6583 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6585 endif ! (MyRank.gt.0)
6589 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6590 if (MyRank.lt.fgProcs-1) then
6591 C Receive correlation contributions from the next processor
6593 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6594 cd write (iout,*) 'Processor',MyID,
6595 cd & ' is receiving correlation contribution from processor',MyID+1,
6596 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6597 cd write (*,*) 'Processor',MyID,
6598 cd & ' is receiving correlation contribution from processor',MyID+1,
6599 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6601 do while (nbytes.le.0)
6602 call mp_probe(MyID+1,CorrelType,nbytes)
6604 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6605 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6606 cd write (iout,*) 'Processor',MyID,
6607 cd & ' has received correlation contribution from processor',MyID+1,
6608 cd & ' msglen=',msglen,' nbytes=',nbytes
6609 cd write (iout,*) 'The received BUFFER array:'
6611 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6613 if (msglen.eq.msglen1) then
6614 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6615 else if (msglen.eq.msglen2) then
6616 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6617 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6620 & 'ERROR!!!! message length changed while processing correlations.'
6622 & 'ERROR!!!! message length changed while processing correlations.'
6623 call mp_stopall(Error)
6624 endif ! msglen.eq.msglen1
6625 endif ! MyRank.lt.fgProcs-1
6632 write (iout,'(a)') 'Contact function values:'
6634 write (iout,'(2i3,50(1x,i2,f5.2))')
6635 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6636 & j=1,num_cont_hb(i))
6640 C Remove the loop below after debugging !!!
6647 C Calculate the local-electrostatic correlation terms
6648 do i=iatel_s,iatel_e+1
6650 num_conti=num_cont_hb(i)
6651 num_conti1=num_cont_hb(i+1)
6656 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6657 c & ' jj=',jj,' kk=',kk
6658 if (j1.eq.j+1 .or. j1.eq.j-1) then
6659 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6660 C The system gains extra energy.
6661 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6663 else if (j1.eq.j) then
6664 C Contacts I-J and I-(J+1) occur simultaneously.
6665 C The system loses extra energy.
6666 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6671 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6672 c & ' jj=',jj,' kk=',kk
6674 C Contacts I-J and (I+1)-J occur simultaneously.
6675 C The system loses extra energy.
6676 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6683 c------------------------------------------------------------------------------
6684 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6686 C This subroutine calculates multi-body contributions to hydrogen-bonding
6687 implicit real*8 (a-h,o-z)
6688 include 'DIMENSIONS'
6689 include 'DIMENSIONS.ZSCOPT'
6690 include 'COMMON.IOUNITS'
6692 include 'COMMON.INFO'
6694 include 'COMMON.FFIELD'
6695 include 'COMMON.DERIV'
6696 include 'COMMON.INTERACT'
6697 include 'COMMON.CONTACTS'
6699 parameter (max_cont=maxconts)
6700 parameter (max_dim=2*(8*3+2))
6701 parameter (msglen1=max_cont*max_dim*4)
6702 parameter (msglen2=2*msglen1)
6703 integer source,CorrelType,CorrelID,Error
6704 double precision buffer(max_cont,max_dim)
6706 double precision gx(3),gx1(3)
6709 C Set lprn=.true. for debugging
6715 if (fgProcs.le.1) goto 30
6717 write (iout,'(a)') 'Contact function values:'
6719 write (iout,'(2i3,50(1x,i2,f5.2))')
6720 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6721 & j=1,num_cont_hb(i))
6724 C Caution! Following code assumes that electrostatic interactions concerning
6725 C a given atom are split among at most two processors!
6735 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6738 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6739 if (MyRank.gt.0) then
6740 C Send correlation contributions to the preceding processor
6742 nn=num_cont_hb(iatel_s)
6743 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6744 cd write (iout,*) 'The BUFFER array:'
6746 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6748 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6750 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6751 C Clear the contacts of the atom passed to the neighboring processor
6752 nn=num_cont_hb(iatel_s+1)
6754 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6756 num_cont_hb(iatel_s)=0
6758 cd write (iout,*) 'Processor ',MyID,MyRank,
6759 cd & ' is sending correlation contribution to processor',MyID-1,
6760 cd & ' msglen=',msglen
6761 cd write (*,*) 'Processor ',MyID,MyRank,
6762 cd & ' is sending correlation contribution to processor',MyID-1,
6763 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6764 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6765 cd write (iout,*) 'Processor ',MyID,
6766 cd & ' has sent correlation contribution to processor',MyID-1,
6767 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6768 cd write (*,*) 'Processor ',MyID,
6769 cd & ' has sent correlation contribution to processor',MyID-1,
6770 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6772 endif ! (MyRank.gt.0)
6776 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6777 if (MyRank.lt.fgProcs-1) then
6778 C Receive correlation contributions from the next processor
6780 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6781 cd write (iout,*) 'Processor',MyID,
6782 cd & ' is receiving correlation contribution from processor',MyID+1,
6783 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6784 cd write (*,*) 'Processor',MyID,
6785 cd & ' is receiving correlation contribution from processor',MyID+1,
6786 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6788 do while (nbytes.le.0)
6789 call mp_probe(MyID+1,CorrelType,nbytes)
6791 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6792 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6793 cd write (iout,*) 'Processor',MyID,
6794 cd & ' has received correlation contribution from processor',MyID+1,
6795 cd & ' msglen=',msglen,' nbytes=',nbytes
6796 cd write (iout,*) 'The received BUFFER array:'
6798 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6800 if (msglen.eq.msglen1) then
6801 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6802 else if (msglen.eq.msglen2) then
6803 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6804 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6807 & 'ERROR!!!! message length changed while processing correlations.'
6809 & 'ERROR!!!! message length changed while processing correlations.'
6810 call mp_stopall(Error)
6811 endif ! msglen.eq.msglen1
6812 endif ! MyRank.lt.fgProcs-1
6819 write (iout,'(a)') 'Contact function values:'
6821 write (iout,'(2i3,50(1x,i2,f5.2))')
6822 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6823 & j=1,num_cont_hb(i))
6829 C Remove the loop below after debugging !!!
6836 C Calculate the dipole-dipole interaction energies
6837 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6838 do i=iatel_s,iatel_e+1
6839 num_conti=num_cont_hb(i)
6846 C Calculate the local-electrostatic correlation terms
6847 do i=iatel_s,iatel_e+1
6849 num_conti=num_cont_hb(i)
6850 num_conti1=num_cont_hb(i+1)
6855 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6856 c & ' jj=',jj,' kk=',kk
6857 if (j1.eq.j+1 .or. j1.eq.j-1) then
6858 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6859 C The system gains extra energy.
6861 sqd1=dsqrt(d_cont(jj,i))
6862 sqd2=dsqrt(d_cont(kk,i1))
6863 sred_geom = sqd1*sqd2
6864 IF (sred_geom.lt.cutoff_corr) THEN
6865 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6867 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6868 c & ' jj=',jj,' kk=',kk
6869 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6870 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6872 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6873 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6876 cd write (iout,*) 'sred_geom=',sred_geom,
6877 cd & ' ekont=',ekont,' fprim=',fprimcont
6878 call calc_eello(i,j,i+1,j1,jj,kk)
6879 if (wcorr4.gt.0.0d0)
6880 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6881 if (wcorr5.gt.0.0d0)
6882 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6883 c print *,"wcorr5",ecorr5
6884 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6885 cd write(2,*)'ijkl',i,j,i+1,j1
6886 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6887 & .or. wturn6.eq.0.0d0))then
6888 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6889 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6890 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6891 cd & 'ecorr6=',ecorr6
6892 cd write (iout,'(4e15.5)') sred_geom,
6893 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6894 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6895 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6896 else if (wturn6.gt.0.0d0
6897 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6898 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6899 eturn6=eturn6+eello_turn6(i,jj,kk)
6900 cd write (2,*) 'multibody_eello:eturn6',eturn6
6904 else if (j1.eq.j) then
6905 C Contacts I-J and I-(J+1) occur simultaneously.
6906 C The system loses extra energy.
6907 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6912 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6913 c & ' jj=',jj,' kk=',kk
6915 C Contacts I-J and (I+1)-J occur simultaneously.
6916 C The system loses extra energy.
6917 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6924 c------------------------------------------------------------------------------
6925 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6926 implicit real*8 (a-h,o-z)
6927 include 'DIMENSIONS'
6928 include 'COMMON.IOUNITS'
6929 include 'COMMON.DERIV'
6930 include 'COMMON.INTERACT'
6931 include 'COMMON.CONTACTS'
6932 double precision gx(3),gx1(3)
6942 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6943 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6944 C Following 4 lines for diagnostics.
6949 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6951 c write (iout,*)'Contacts have occurred for peptide groups',
6952 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6953 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6954 C Calculate the multi-body contribution to energy.
6955 ecorr=ecorr+ekont*ees
6957 C Calculate multi-body contributions to the gradient.
6959 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6960 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6961 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6962 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6963 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6964 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6965 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6966 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6967 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6968 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6969 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6970 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6971 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6972 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6976 gradcorr(ll,m)=gradcorr(ll,m)+
6977 & ees*ekl*gacont_hbr(ll,jj,i)-
6978 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6979 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6984 gradcorr(ll,m)=gradcorr(ll,m)+
6985 & ees*eij*gacont_hbr(ll,kk,k)-
6986 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6987 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6994 C---------------------------------------------------------------------------
6995 subroutine dipole(i,j,jj)
6996 implicit real*8 (a-h,o-z)
6997 include 'DIMENSIONS'
6998 include 'DIMENSIONS.ZSCOPT'
6999 include 'COMMON.IOUNITS'
7000 include 'COMMON.CHAIN'
7001 include 'COMMON.FFIELD'
7002 include 'COMMON.DERIV'
7003 include 'COMMON.INTERACT'
7004 include 'COMMON.CONTACTS'
7005 include 'COMMON.TORSION'
7006 include 'COMMON.VAR'
7007 include 'COMMON.GEO'
7008 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7010 iti1 = itortyp(itype(i+1))
7011 if (j.lt.nres-1) then
7012 itj1 = itortyp(itype(j+1))
7017 dipi(iii,1)=Ub2(iii,i)
7018 dipderi(iii)=Ub2der(iii,i)
7019 dipi(iii,2)=b1(iii,iti1)
7020 dipj(iii,1)=Ub2(iii,j)
7021 dipderj(iii)=Ub2der(iii,j)
7022 dipj(iii,2)=b1(iii,itj1)
7026 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7029 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7032 if (.not.calc_grad) return
7037 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7041 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7046 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7047 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7049 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7051 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7053 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7057 C---------------------------------------------------------------------------
7058 subroutine calc_eello(i,j,k,l,jj,kk)
7060 C This subroutine computes matrices and vectors needed to calculate
7061 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7063 implicit real*8 (a-h,o-z)
7064 include 'DIMENSIONS'
7065 include 'DIMENSIONS.ZSCOPT'
7066 include 'COMMON.IOUNITS'
7067 include 'COMMON.CHAIN'
7068 include 'COMMON.DERIV'
7069 include 'COMMON.INTERACT'
7070 include 'COMMON.CONTACTS'
7071 include 'COMMON.TORSION'
7072 include 'COMMON.VAR'
7073 include 'COMMON.GEO'
7074 include 'COMMON.FFIELD'
7075 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7076 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7079 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7080 cd & ' jj=',jj,' kk=',kk
7081 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7084 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7085 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7088 call transpose2(aa1(1,1),aa1t(1,1))
7089 call transpose2(aa2(1,1),aa2t(1,1))
7092 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7093 & aa1tder(1,1,lll,kkk))
7094 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7095 & aa2tder(1,1,lll,kkk))
7099 C parallel orientation of the two CA-CA-CA frames.
7101 iti=itortyp(itype(i))
7105 itk1=itortyp(itype(k+1))
7106 itj=itortyp(itype(j))
7107 if (l.lt.nres-1) then
7108 itl1=itortyp(itype(l+1))
7112 C A1 kernel(j+1) A2T
7114 cd write (iout,'(3f10.5,5x,3f10.5)')
7115 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7117 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7118 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7119 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7120 C Following matrices are needed only for 6-th order cumulants
7121 IF (wcorr6.gt.0.0d0) THEN
7122 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7123 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7124 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7125 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7126 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7127 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7128 & ADtEAderx(1,1,1,1,1,1))
7130 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7131 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7132 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7133 & ADtEA1derx(1,1,1,1,1,1))
7135 C End 6-th order cumulants
7138 cd write (2,*) 'In calc_eello6'
7140 cd write (2,*) 'iii=',iii
7142 cd write (2,*) 'kkk=',kkk
7144 cd write (2,'(3(2f10.5),5x)')
7145 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7150 call transpose2(EUgder(1,1,k),auxmat(1,1))
7151 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7152 call transpose2(EUg(1,1,k),auxmat(1,1))
7153 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7154 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7158 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7159 & EAEAderx(1,1,lll,kkk,iii,1))
7163 C A1T kernel(i+1) A2
7164 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7165 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7166 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7167 C Following matrices are needed only for 6-th order cumulants
7168 IF (wcorr6.gt.0.0d0) THEN
7169 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7170 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7171 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7172 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7173 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7174 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7175 & ADtEAderx(1,1,1,1,1,2))
7176 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7177 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7178 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7179 & ADtEA1derx(1,1,1,1,1,2))
7181 C End 6-th order cumulants
7182 call transpose2(EUgder(1,1,l),auxmat(1,1))
7183 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7184 call transpose2(EUg(1,1,l),auxmat(1,1))
7185 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7186 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7190 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7191 & EAEAderx(1,1,lll,kkk,iii,2))
7196 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7197 C They are needed only when the fifth- or the sixth-order cumulants are
7199 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7200 call transpose2(AEA(1,1,1),auxmat(1,1))
7201 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7202 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7203 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7204 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7205 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7206 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7207 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7208 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7209 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7210 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7211 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7212 call transpose2(AEA(1,1,2),auxmat(1,1))
7213 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7214 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7215 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7216 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7217 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7218 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7219 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7220 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7221 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7222 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7223 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7224 C Calculate the Cartesian derivatives of the vectors.
7228 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7229 call matvec2(auxmat(1,1),b1(1,iti),
7230 & AEAb1derx(1,lll,kkk,iii,1,1))
7231 call matvec2(auxmat(1,1),Ub2(1,i),
7232 & AEAb2derx(1,lll,kkk,iii,1,1))
7233 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7234 & AEAb1derx(1,lll,kkk,iii,2,1))
7235 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7236 & AEAb2derx(1,lll,kkk,iii,2,1))
7237 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7238 call matvec2(auxmat(1,1),b1(1,itj),
7239 & AEAb1derx(1,lll,kkk,iii,1,2))
7240 call matvec2(auxmat(1,1),Ub2(1,j),
7241 & AEAb2derx(1,lll,kkk,iii,1,2))
7242 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7243 & AEAb1derx(1,lll,kkk,iii,2,2))
7244 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7245 & AEAb2derx(1,lll,kkk,iii,2,2))
7252 C Antiparallel orientation of the two CA-CA-CA frames.
7254 iti=itortyp(itype(i))
7258 itk1=itortyp(itype(k+1))
7259 itl=itortyp(itype(l))
7260 itj=itortyp(itype(j))
7261 if (j.lt.nres-1) then
7262 itj1=itortyp(itype(j+1))
7266 C A2 kernel(j-1)T A1T
7267 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7268 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7269 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7270 C Following matrices are needed only for 6-th order cumulants
7271 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7272 & j.eq.i+4 .and. l.eq.i+3)) THEN
7273 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7274 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7275 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7276 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7277 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7278 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7279 & ADtEAderx(1,1,1,1,1,1))
7280 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7281 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7282 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7283 & ADtEA1derx(1,1,1,1,1,1))
7285 C End 6-th order cumulants
7286 call transpose2(EUgder(1,1,k),auxmat(1,1))
7287 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7288 call transpose2(EUg(1,1,k),auxmat(1,1))
7289 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7290 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7294 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7295 & EAEAderx(1,1,lll,kkk,iii,1))
7299 C A2T kernel(i+1)T A1
7300 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7301 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7302 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7303 C Following matrices are needed only for 6-th order cumulants
7304 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7305 & j.eq.i+4 .and. l.eq.i+3)) THEN
7306 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7307 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7308 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7309 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7310 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7311 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7312 & ADtEAderx(1,1,1,1,1,2))
7313 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7314 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7315 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7316 & ADtEA1derx(1,1,1,1,1,2))
7318 C End 6-th order cumulants
7319 call transpose2(EUgder(1,1,j),auxmat(1,1))
7320 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7321 call transpose2(EUg(1,1,j),auxmat(1,1))
7322 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7323 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7327 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7328 & EAEAderx(1,1,lll,kkk,iii,2))
7333 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7334 C They are needed only when the fifth- or the sixth-order cumulants are
7336 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7337 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7338 call transpose2(AEA(1,1,1),auxmat(1,1))
7339 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7340 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7341 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7342 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7343 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7344 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7345 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7346 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7347 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7348 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7349 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7350 call transpose2(AEA(1,1,2),auxmat(1,1))
7351 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7352 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7353 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7354 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7355 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7356 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7357 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7358 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7359 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7360 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7361 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7362 C Calculate the Cartesian derivatives of the vectors.
7366 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7367 call matvec2(auxmat(1,1),b1(1,iti),
7368 & AEAb1derx(1,lll,kkk,iii,1,1))
7369 call matvec2(auxmat(1,1),Ub2(1,i),
7370 & AEAb2derx(1,lll,kkk,iii,1,1))
7371 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7372 & AEAb1derx(1,lll,kkk,iii,2,1))
7373 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7374 & AEAb2derx(1,lll,kkk,iii,2,1))
7375 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7376 call matvec2(auxmat(1,1),b1(1,itl),
7377 & AEAb1derx(1,lll,kkk,iii,1,2))
7378 call matvec2(auxmat(1,1),Ub2(1,l),
7379 & AEAb2derx(1,lll,kkk,iii,1,2))
7380 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7381 & AEAb1derx(1,lll,kkk,iii,2,2))
7382 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7383 & AEAb2derx(1,lll,kkk,iii,2,2))
7392 C---------------------------------------------------------------------------
7393 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7394 & KK,KKderg,AKA,AKAderg,AKAderx)
7398 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7399 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7400 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7405 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7407 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7410 cd if (lprn) write (2,*) 'In kernel'
7412 cd if (lprn) write (2,*) 'kkk=',kkk
7414 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7415 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7417 cd write (2,*) 'lll=',lll
7418 cd write (2,*) 'iii=1'
7420 cd write (2,'(3(2f10.5),5x)')
7421 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7424 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7425 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7427 cd write (2,*) 'lll=',lll
7428 cd write (2,*) 'iii=2'
7430 cd write (2,'(3(2f10.5),5x)')
7431 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7438 C---------------------------------------------------------------------------
7439 double precision function eello4(i,j,k,l,jj,kk)
7440 implicit real*8 (a-h,o-z)
7441 include 'DIMENSIONS'
7442 include 'DIMENSIONS.ZSCOPT'
7443 include 'COMMON.IOUNITS'
7444 include 'COMMON.CHAIN'
7445 include 'COMMON.DERIV'
7446 include 'COMMON.INTERACT'
7447 include 'COMMON.CONTACTS'
7448 include 'COMMON.TORSION'
7449 include 'COMMON.VAR'
7450 include 'COMMON.GEO'
7451 double precision pizda(2,2),ggg1(3),ggg2(3)
7452 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7456 cd print *,'eello4:',i,j,k,l,jj,kk
7457 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7458 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7459 cold eij=facont_hb(jj,i)
7460 cold ekl=facont_hb(kk,k)
7462 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7464 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7465 gcorr_loc(k-1)=gcorr_loc(k-1)
7466 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7468 gcorr_loc(l-1)=gcorr_loc(l-1)
7469 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7471 gcorr_loc(j-1)=gcorr_loc(j-1)
7472 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7477 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7478 & -EAEAderx(2,2,lll,kkk,iii,1)
7479 cd derx(lll,kkk,iii)=0.0d0
7483 cd gcorr_loc(l-1)=0.0d0
7484 cd gcorr_loc(j-1)=0.0d0
7485 cd gcorr_loc(k-1)=0.0d0
7487 cd write (iout,*)'Contacts have occurred for peptide groups',
7488 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7489 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7490 if (j.lt.nres-1) then
7497 if (l.lt.nres-1) then
7505 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
7506 ggg1(ll)=eel4*g_contij(ll,1)
7507 ggg2(ll)=eel4*g_contij(ll,2)
7508 ghalf=0.5d0*ggg1(ll)
7510 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
7511 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7512 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
7513 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7514 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
7515 ghalf=0.5d0*ggg2(ll)
7517 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
7518 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7519 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
7520 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7525 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
7526 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7531 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
7532 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7538 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7543 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7547 cd write (2,*) iii,gcorr_loc(iii)
7551 cd write (2,*) 'ekont',ekont
7552 cd write (iout,*) 'eello4',ekont*eel4
7555 C---------------------------------------------------------------------------
7556 double precision function eello5(i,j,k,l,jj,kk)
7557 implicit real*8 (a-h,o-z)
7558 include 'DIMENSIONS'
7559 include 'DIMENSIONS.ZSCOPT'
7560 include 'COMMON.IOUNITS'
7561 include 'COMMON.CHAIN'
7562 include 'COMMON.DERIV'
7563 include 'COMMON.INTERACT'
7564 include 'COMMON.CONTACTS'
7565 include 'COMMON.TORSION'
7566 include 'COMMON.VAR'
7567 include 'COMMON.GEO'
7568 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7569 double precision ggg1(3),ggg2(3)
7570 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7575 C /l\ / \ \ / \ / \ / C
7576 C / \ / \ \ / \ / \ / C
7577 C j| o |l1 | o | o| o | | o |o C
7578 C \ |/k\| |/ \| / |/ \| |/ \| C
7579 C \i/ \ / \ / / \ / \ C
7581 C (I) (II) (III) (IV) C
7583 C eello5_1 eello5_2 eello5_3 eello5_4 C
7585 C Antiparallel chains C
7588 C /j\ / \ \ / \ / \ / C
7589 C / \ / \ \ / \ / \ / C
7590 C j1| o |l | o | o| o | | o |o C
7591 C \ |/k\| |/ \| / |/ \| |/ \| C
7592 C \i/ \ / \ / / \ / \ C
7594 C (I) (II) (III) (IV) C
7596 C eello5_1 eello5_2 eello5_3 eello5_4 C
7598 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7600 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7601 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7606 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7608 itk=itortyp(itype(k))
7609 itl=itortyp(itype(l))
7610 itj=itortyp(itype(j))
7615 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7616 cd & eel5_3_num,eel5_4_num)
7620 derx(lll,kkk,iii)=0.0d0
7624 cd eij=facont_hb(jj,i)
7625 cd ekl=facont_hb(kk,k)
7627 cd write (iout,*)'Contacts have occurred for peptide groups',
7628 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7630 C Contribution from the graph I.
7631 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7632 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7633 call transpose2(EUg(1,1,k),auxmat(1,1))
7634 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7635 vv(1)=pizda(1,1)-pizda(2,2)
7636 vv(2)=pizda(1,2)+pizda(2,1)
7637 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7638 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7640 C Explicit gradient in virtual-dihedral angles.
7641 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7642 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7643 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7644 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7645 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7646 vv(1)=pizda(1,1)-pizda(2,2)
7647 vv(2)=pizda(1,2)+pizda(2,1)
7648 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7649 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7650 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7651 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7652 vv(1)=pizda(1,1)-pizda(2,2)
7653 vv(2)=pizda(1,2)+pizda(2,1)
7655 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7656 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7657 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7659 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7660 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7661 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7663 C Cartesian gradient
7667 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7669 vv(1)=pizda(1,1)-pizda(2,2)
7670 vv(2)=pizda(1,2)+pizda(2,1)
7671 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7672 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7673 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7680 C Contribution from graph II
7681 call transpose2(EE(1,1,itk),auxmat(1,1))
7682 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7683 vv(1)=pizda(1,1)+pizda(2,2)
7684 vv(2)=pizda(2,1)-pizda(1,2)
7685 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7686 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7688 C Explicit gradient in virtual-dihedral angles.
7689 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7690 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7691 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7692 vv(1)=pizda(1,1)+pizda(2,2)
7693 vv(2)=pizda(2,1)-pizda(1,2)
7695 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7696 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7697 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7699 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7700 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7701 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7703 C Cartesian gradient
7707 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7709 vv(1)=pizda(1,1)+pizda(2,2)
7710 vv(2)=pizda(2,1)-pizda(1,2)
7711 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7712 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7713 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7722 C Parallel orientation
7723 C Contribution from graph III
7724 call transpose2(EUg(1,1,l),auxmat(1,1))
7725 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7726 vv(1)=pizda(1,1)-pizda(2,2)
7727 vv(2)=pizda(1,2)+pizda(2,1)
7728 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7729 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7731 C Explicit gradient in virtual-dihedral angles.
7732 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7733 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7734 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7735 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7736 vv(1)=pizda(1,1)-pizda(2,2)
7737 vv(2)=pizda(1,2)+pizda(2,1)
7738 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7739 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7740 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7741 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7742 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7743 vv(1)=pizda(1,1)-pizda(2,2)
7744 vv(2)=pizda(1,2)+pizda(2,1)
7745 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7746 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7747 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7748 C Cartesian gradient
7752 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7754 vv(1)=pizda(1,1)-pizda(2,2)
7755 vv(2)=pizda(1,2)+pizda(2,1)
7756 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7757 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7758 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7764 C Contribution from graph IV
7766 call transpose2(EE(1,1,itl),auxmat(1,1))
7767 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7768 vv(1)=pizda(1,1)+pizda(2,2)
7769 vv(2)=pizda(2,1)-pizda(1,2)
7770 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7771 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7773 C Explicit gradient in virtual-dihedral angles.
7774 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7775 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7776 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7777 vv(1)=pizda(1,1)+pizda(2,2)
7778 vv(2)=pizda(2,1)-pizda(1,2)
7779 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7780 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7781 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7782 C Cartesian gradient
7786 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7788 vv(1)=pizda(1,1)+pizda(2,2)
7789 vv(2)=pizda(2,1)-pizda(1,2)
7790 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7791 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7792 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7798 C Antiparallel orientation
7799 C Contribution from graph III
7801 call transpose2(EUg(1,1,j),auxmat(1,1))
7802 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7803 vv(1)=pizda(1,1)-pizda(2,2)
7804 vv(2)=pizda(1,2)+pizda(2,1)
7805 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7806 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7808 C Explicit gradient in virtual-dihedral angles.
7809 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7810 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7811 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7812 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7813 vv(1)=pizda(1,1)-pizda(2,2)
7814 vv(2)=pizda(1,2)+pizda(2,1)
7815 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7816 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7817 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7818 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7819 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7820 vv(1)=pizda(1,1)-pizda(2,2)
7821 vv(2)=pizda(1,2)+pizda(2,1)
7822 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7823 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7824 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7825 C Cartesian gradient
7829 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7831 vv(1)=pizda(1,1)-pizda(2,2)
7832 vv(2)=pizda(1,2)+pizda(2,1)
7833 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7834 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7835 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7841 C Contribution from graph IV
7843 call transpose2(EE(1,1,itj),auxmat(1,1))
7844 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7845 vv(1)=pizda(1,1)+pizda(2,2)
7846 vv(2)=pizda(2,1)-pizda(1,2)
7847 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7848 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7850 C Explicit gradient in virtual-dihedral angles.
7851 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7852 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7853 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7854 vv(1)=pizda(1,1)+pizda(2,2)
7855 vv(2)=pizda(2,1)-pizda(1,2)
7856 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7857 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7858 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7859 C Cartesian gradient
7863 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7865 vv(1)=pizda(1,1)+pizda(2,2)
7866 vv(2)=pizda(2,1)-pizda(1,2)
7867 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7868 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7869 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7876 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7877 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7878 cd write (2,*) 'ijkl',i,j,k,l
7879 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7880 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7882 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7883 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7884 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7885 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7887 if (j.lt.nres-1) then
7894 if (l.lt.nres-1) then
7904 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7906 ggg1(ll)=eel5*g_contij(ll,1)
7907 ggg2(ll)=eel5*g_contij(ll,2)
7908 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7909 ghalf=0.5d0*ggg1(ll)
7911 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7912 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7913 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7914 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7915 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7916 ghalf=0.5d0*ggg2(ll)
7918 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7919 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7920 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7921 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7926 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7927 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7932 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7933 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7939 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7944 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7948 cd write (2,*) iii,g_corr5_loc(iii)
7952 cd write (2,*) 'ekont',ekont
7953 cd write (iout,*) 'eello5',ekont*eel5
7956 c--------------------------------------------------------------------------
7957 double precision function eello6(i,j,k,l,jj,kk)
7958 implicit real*8 (a-h,o-z)
7959 include 'DIMENSIONS'
7960 include 'DIMENSIONS.ZSCOPT'
7961 include 'COMMON.IOUNITS'
7962 include 'COMMON.CHAIN'
7963 include 'COMMON.DERIV'
7964 include 'COMMON.INTERACT'
7965 include 'COMMON.CONTACTS'
7966 include 'COMMON.TORSION'
7967 include 'COMMON.VAR'
7968 include 'COMMON.GEO'
7969 include 'COMMON.FFIELD'
7970 double precision ggg1(3),ggg2(3)
7971 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7976 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7984 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7985 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7989 derx(lll,kkk,iii)=0.0d0
7993 cd eij=facont_hb(jj,i)
7994 cd ekl=facont_hb(kk,k)
8000 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8001 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8002 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8003 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8004 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8005 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8007 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8008 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8009 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8010 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8011 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8012 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8016 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8018 C If turn contributions are considered, they will be handled separately.
8019 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8020 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
8021 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
8022 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
8023 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
8024 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
8025 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
8028 if (j.lt.nres-1) then
8035 if (l.lt.nres-1) then
8043 ggg1(ll)=eel6*g_contij(ll,1)
8044 ggg2(ll)=eel6*g_contij(ll,2)
8045 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8046 ghalf=0.5d0*ggg1(ll)
8048 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
8049 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8050 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
8051 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8052 ghalf=0.5d0*ggg2(ll)
8053 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8055 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
8056 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8057 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
8058 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8063 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8064 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8069 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8070 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8076 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8081 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8085 cd write (2,*) iii,g_corr6_loc(iii)
8089 cd write (2,*) 'ekont',ekont
8090 cd write (iout,*) 'eello6',ekont*eel6
8093 c--------------------------------------------------------------------------
8094 double precision function eello6_graph1(i,j,k,l,imat,swap)
8095 implicit real*8 (a-h,o-z)
8096 include 'DIMENSIONS'
8097 include 'DIMENSIONS.ZSCOPT'
8098 include 'COMMON.IOUNITS'
8099 include 'COMMON.CHAIN'
8100 include 'COMMON.DERIV'
8101 include 'COMMON.INTERACT'
8102 include 'COMMON.CONTACTS'
8103 include 'COMMON.TORSION'
8104 include 'COMMON.VAR'
8105 include 'COMMON.GEO'
8106 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8110 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8112 C Parallel Antiparallel C
8118 C \ j|/k\| / \ |/k\|l / C
8123 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8124 itk=itortyp(itype(k))
8125 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8126 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8127 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8128 call transpose2(EUgC(1,1,k),auxmat(1,1))
8129 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8130 vv1(1)=pizda1(1,1)-pizda1(2,2)
8131 vv1(2)=pizda1(1,2)+pizda1(2,1)
8132 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8133 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8134 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8135 s5=scalar2(vv(1),Dtobr2(1,i))
8136 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8137 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8138 if (.not. calc_grad) return
8139 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8140 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8141 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8142 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8143 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8144 & +scalar2(vv(1),Dtobr2der(1,i)))
8145 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8146 vv1(1)=pizda1(1,1)-pizda1(2,2)
8147 vv1(2)=pizda1(1,2)+pizda1(2,1)
8148 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8149 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8151 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8152 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8153 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8154 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8155 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8157 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8158 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8159 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8160 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8161 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8163 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8164 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8165 vv1(1)=pizda1(1,1)-pizda1(2,2)
8166 vv1(2)=pizda1(1,2)+pizda1(2,1)
8167 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8168 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8169 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8170 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8179 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8180 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8181 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8182 call transpose2(EUgC(1,1,k),auxmat(1,1))
8183 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8185 vv1(1)=pizda1(1,1)-pizda1(2,2)
8186 vv1(2)=pizda1(1,2)+pizda1(2,1)
8187 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8188 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8189 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8190 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8191 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8192 s5=scalar2(vv(1),Dtobr2(1,i))
8193 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8199 c----------------------------------------------------------------------------
8200 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8201 implicit real*8 (a-h,o-z)
8202 include 'DIMENSIONS'
8203 include 'DIMENSIONS.ZSCOPT'
8204 include 'COMMON.IOUNITS'
8205 include 'COMMON.CHAIN'
8206 include 'COMMON.DERIV'
8207 include 'COMMON.INTERACT'
8208 include 'COMMON.CONTACTS'
8209 include 'COMMON.TORSION'
8210 include 'COMMON.VAR'
8211 include 'COMMON.GEO'
8213 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8214 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8217 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8219 C Parallel Antiparallel C
8225 C \ j|/k\| \ |/k\|l C
8230 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8231 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8232 C AL 7/4/01 s1 would occur in the sixth-order moment,
8233 C but not in a cluster cumulant
8235 s1=dip(1,jj,i)*dip(1,kk,k)
8237 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8238 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8239 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8240 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8241 call transpose2(EUg(1,1,k),auxmat(1,1))
8242 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8243 vv(1)=pizda(1,1)-pizda(2,2)
8244 vv(2)=pizda(1,2)+pizda(2,1)
8245 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8246 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8248 eello6_graph2=-(s1+s2+s3+s4)
8250 eello6_graph2=-(s2+s3+s4)
8253 if (.not. calc_grad) return
8254 C Derivatives in gamma(i-1)
8257 s1=dipderg(1,jj,i)*dip(1,kk,k)
8259 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8260 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8261 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8262 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8264 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8266 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8268 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8270 C Derivatives in gamma(k-1)
8272 s1=dip(1,jj,i)*dipderg(1,kk,k)
8274 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8275 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8276 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8277 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8278 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8279 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8280 vv(1)=pizda(1,1)-pizda(2,2)
8281 vv(2)=pizda(1,2)+pizda(2,1)
8282 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8284 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8286 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8288 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8289 C Derivatives in gamma(j-1) or gamma(l-1)
8292 s1=dipderg(3,jj,i)*dip(1,kk,k)
8294 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8295 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8296 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8297 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8298 vv(1)=pizda(1,1)-pizda(2,2)
8299 vv(2)=pizda(1,2)+pizda(2,1)
8300 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8303 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8305 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8308 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8309 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8311 C Derivatives in gamma(l-1) or gamma(j-1)
8314 s1=dip(1,jj,i)*dipderg(3,kk,k)
8316 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8317 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8318 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8319 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8320 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8321 vv(1)=pizda(1,1)-pizda(2,2)
8322 vv(2)=pizda(1,2)+pizda(2,1)
8323 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8326 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8328 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8331 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8332 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8334 C Cartesian derivatives.
8336 write (2,*) 'In eello6_graph2'
8338 write (2,*) 'iii=',iii
8340 write (2,*) 'kkk=',kkk
8342 write (2,'(3(2f10.5),5x)')
8343 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8353 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8355 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8358 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8360 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8361 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8363 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8364 call transpose2(EUg(1,1,k),auxmat(1,1))
8365 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8367 vv(1)=pizda(1,1)-pizda(2,2)
8368 vv(2)=pizda(1,2)+pizda(2,1)
8369 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8370 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8372 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8374 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8377 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8379 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8386 c----------------------------------------------------------------------------
8387 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8388 implicit real*8 (a-h,o-z)
8389 include 'DIMENSIONS'
8390 include 'DIMENSIONS.ZSCOPT'
8391 include 'COMMON.IOUNITS'
8392 include 'COMMON.CHAIN'
8393 include 'COMMON.DERIV'
8394 include 'COMMON.INTERACT'
8395 include 'COMMON.CONTACTS'
8396 include 'COMMON.TORSION'
8397 include 'COMMON.VAR'
8398 include 'COMMON.GEO'
8399 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8401 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8403 C Parallel Antiparallel C
8409 C j|/k\| / |/k\|l / C
8414 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8416 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8417 C energy moment and not to the cluster cumulant.
8418 iti=itortyp(itype(i))
8419 if (j.lt.nres-1) then
8420 itj1=itortyp(itype(j+1))
8424 itk=itortyp(itype(k))
8425 itk1=itortyp(itype(k+1))
8426 if (l.lt.nres-1) then
8427 itl1=itortyp(itype(l+1))
8432 s1=dip(4,jj,i)*dip(4,kk,k)
8434 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8435 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8436 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8437 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8438 call transpose2(EE(1,1,itk),auxmat(1,1))
8439 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8440 vv(1)=pizda(1,1)+pizda(2,2)
8441 vv(2)=pizda(2,1)-pizda(1,2)
8442 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8443 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8445 eello6_graph3=-(s1+s2+s3+s4)
8447 eello6_graph3=-(s2+s3+s4)
8450 if (.not. calc_grad) return
8451 C Derivatives in gamma(k-1)
8452 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8453 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8454 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8455 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8456 C Derivatives in gamma(l-1)
8457 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8458 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8459 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8460 vv(1)=pizda(1,1)+pizda(2,2)
8461 vv(2)=pizda(2,1)-pizda(1,2)
8462 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8463 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8464 C Cartesian derivatives.
8470 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8472 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8475 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8477 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8478 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8480 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8481 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8483 vv(1)=pizda(1,1)+pizda(2,2)
8484 vv(2)=pizda(2,1)-pizda(1,2)
8485 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8487 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8489 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8492 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8494 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8496 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8502 c----------------------------------------------------------------------------
8503 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8504 implicit real*8 (a-h,o-z)
8505 include 'DIMENSIONS'
8506 include 'DIMENSIONS.ZSCOPT'
8507 include 'COMMON.IOUNITS'
8508 include 'COMMON.CHAIN'
8509 include 'COMMON.DERIV'
8510 include 'COMMON.INTERACT'
8511 include 'COMMON.CONTACTS'
8512 include 'COMMON.TORSION'
8513 include 'COMMON.VAR'
8514 include 'COMMON.GEO'
8515 include 'COMMON.FFIELD'
8516 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8517 & auxvec1(2),auxmat1(2,2)
8519 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8521 C Parallel Antiparallel C
8527 C \ j|/k\| \ |/k\|l C
8532 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8534 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8535 C energy moment and not to the cluster cumulant.
8536 cd write (2,*) 'eello_graph4: wturn6',wturn6
8537 iti=itortyp(itype(i))
8538 itj=itortyp(itype(j))
8539 if (j.lt.nres-1) then
8540 itj1=itortyp(itype(j+1))
8544 itk=itortyp(itype(k))
8545 if (k.lt.nres-1) then
8546 itk1=itortyp(itype(k+1))
8550 itl=itortyp(itype(l))
8551 if (l.lt.nres-1) then
8552 itl1=itortyp(itype(l+1))
8556 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8557 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8558 cd & ' itl',itl,' itl1',itl1
8561 s1=dip(3,jj,i)*dip(3,kk,k)
8563 s1=dip(2,jj,j)*dip(2,kk,l)
8566 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8567 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8569 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8570 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8572 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8573 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8575 call transpose2(EUg(1,1,k),auxmat(1,1))
8576 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8577 vv(1)=pizda(1,1)-pizda(2,2)
8578 vv(2)=pizda(2,1)+pizda(1,2)
8579 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8580 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8582 eello6_graph4=-(s1+s2+s3+s4)
8584 eello6_graph4=-(s2+s3+s4)
8586 if (.not. calc_grad) return
8587 C Derivatives in gamma(i-1)
8591 s1=dipderg(2,jj,i)*dip(3,kk,k)
8593 s1=dipderg(4,jj,j)*dip(2,kk,l)
8596 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8598 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8599 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8601 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8602 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8604 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8605 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8606 cd write (2,*) 'turn6 derivatives'
8608 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8610 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8614 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8616 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8620 C Derivatives in gamma(k-1)
8623 s1=dip(3,jj,i)*dipderg(2,kk,k)
8625 s1=dip(2,jj,j)*dipderg(4,kk,l)
8628 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8629 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8631 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8632 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8634 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8635 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8637 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8638 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8639 vv(1)=pizda(1,1)-pizda(2,2)
8640 vv(2)=pizda(2,1)+pizda(1,2)
8641 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8642 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8644 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8646 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8650 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8652 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8655 C Derivatives in gamma(j-1) or gamma(l-1)
8656 if (l.eq.j+1 .and. l.gt.1) then
8657 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8658 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8659 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8660 vv(1)=pizda(1,1)-pizda(2,2)
8661 vv(2)=pizda(2,1)+pizda(1,2)
8662 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8663 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8664 else if (j.gt.1) then
8665 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8666 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8667 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8668 vv(1)=pizda(1,1)-pizda(2,2)
8669 vv(2)=pizda(2,1)+pizda(1,2)
8670 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8671 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8672 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8674 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8677 C Cartesian derivatives.
8684 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8686 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8690 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8692 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8696 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8698 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8700 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8701 & b1(1,itj1),auxvec(1))
8702 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8704 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8705 & b1(1,itl1),auxvec(1))
8706 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8708 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8710 vv(1)=pizda(1,1)-pizda(2,2)
8711 vv(2)=pizda(2,1)+pizda(1,2)
8712 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8714 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8716 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8719 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8722 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8725 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8727 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8729 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8733 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8735 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8738 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8740 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8748 c----------------------------------------------------------------------------
8749 double precision function eello_turn6(i,jj,kk)
8750 implicit real*8 (a-h,o-z)
8751 include 'DIMENSIONS'
8752 include 'DIMENSIONS.ZSCOPT'
8753 include 'COMMON.IOUNITS'
8754 include 'COMMON.CHAIN'
8755 include 'COMMON.DERIV'
8756 include 'COMMON.INTERACT'
8757 include 'COMMON.CONTACTS'
8758 include 'COMMON.TORSION'
8759 include 'COMMON.VAR'
8760 include 'COMMON.GEO'
8761 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8762 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8764 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8765 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8766 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8767 C the respective energy moment and not to the cluster cumulant.
8772 iti=itortyp(itype(i))
8773 itk=itortyp(itype(k))
8774 itk1=itortyp(itype(k+1))
8775 itl=itortyp(itype(l))
8776 itj=itortyp(itype(j))
8777 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8778 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8779 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8784 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8786 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8790 derx_turn(lll,kkk,iii)=0.0d0
8797 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8799 cd write (2,*) 'eello6_5',eello6_5
8801 call transpose2(AEA(1,1,1),auxmat(1,1))
8802 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8803 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8804 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8808 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8809 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8810 s2 = scalar2(b1(1,itk),vtemp1(1))
8812 call transpose2(AEA(1,1,2),atemp(1,1))
8813 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8814 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8815 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8819 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8820 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8821 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8823 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8824 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8825 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8826 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8827 ss13 = scalar2(b1(1,itk),vtemp4(1))
8828 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8832 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8838 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8840 C Derivatives in gamma(i+2)
8842 call transpose2(AEA(1,1,1),auxmatd(1,1))
8843 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8844 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8845 call transpose2(AEAderg(1,1,2),atempd(1,1))
8846 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8847 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8851 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8852 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8853 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8859 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8860 C Derivatives in gamma(i+3)
8862 call transpose2(AEA(1,1,1),auxmatd(1,1))
8863 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8864 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8865 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8869 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8870 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8871 s2d = scalar2(b1(1,itk),vtemp1d(1))
8873 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8874 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8876 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8878 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8879 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8880 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8890 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8891 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8893 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8894 & -0.5d0*ekont*(s2d+s12d)
8896 C Derivatives in gamma(i+4)
8897 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8898 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8899 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8901 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8902 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8903 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8913 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8915 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8917 C Derivatives in gamma(i+5)
8919 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8920 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8921 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8925 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8926 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8927 s2d = scalar2(b1(1,itk),vtemp1d(1))
8929 call transpose2(AEA(1,1,2),atempd(1,1))
8930 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8931 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8935 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8936 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8938 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8939 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8940 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8950 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8951 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8953 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8954 & -0.5d0*ekont*(s2d+s12d)
8956 C Cartesian derivatives
8961 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8962 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8963 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8967 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8968 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8970 s2d = scalar2(b1(1,itk),vtemp1d(1))
8972 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8973 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8974 s8d = -(atempd(1,1)+atempd(2,2))*
8975 & scalar2(cc(1,1,itl),vtemp2(1))
8979 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8981 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8982 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8989 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8992 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8996 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8997 & - 0.5d0*(s8d+s12d)
8999 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9008 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9010 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9011 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9012 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9013 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9014 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9016 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9017 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9018 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9022 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9023 cd & 16*eel_turn6_num
9025 if (j.lt.nres-1) then
9032 if (l.lt.nres-1) then
9040 ggg1(ll)=eel_turn6*g_contij(ll,1)
9041 ggg2(ll)=eel_turn6*g_contij(ll,2)
9042 ghalf=0.5d0*ggg1(ll)
9044 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
9045 & +ekont*derx_turn(ll,2,1)
9046 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9047 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
9048 & +ekont*derx_turn(ll,4,1)
9049 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9050 ghalf=0.5d0*ggg2(ll)
9052 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
9053 & +ekont*derx_turn(ll,2,2)
9054 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9055 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
9056 & +ekont*derx_turn(ll,4,2)
9057 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9062 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9067 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9073 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9078 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9082 cd write (2,*) iii,g_corr6_loc(iii)
9085 eello_turn6=ekont*eel_turn6
9086 cd write (2,*) 'ekont',ekont
9087 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9090 crc-------------------------------------------------
9091 SUBROUTINE MATVEC2(A1,V1,V2)
9092 implicit real*8 (a-h,o-z)
9093 include 'DIMENSIONS'
9094 DIMENSION A1(2,2),V1(2),V2(2)
9098 c 3 VI=VI+A1(I,K)*V1(K)
9102 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9103 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9108 C---------------------------------------
9109 SUBROUTINE MATMAT2(A1,A2,A3)
9110 implicit real*8 (a-h,o-z)
9111 include 'DIMENSIONS'
9112 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9113 c DIMENSION AI3(2,2)
9117 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9123 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9124 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9125 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9126 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9134 c-------------------------------------------------------------------------
9135 double precision function scalar2(u,v)
9137 double precision u(2),v(2)
9140 scalar2=u(1)*v(1)+u(2)*v(2)
9144 C-----------------------------------------------------------------------------
9146 subroutine transpose2(a,at)
9148 double precision a(2,2),at(2,2)
9155 c--------------------------------------------------------------------------
9156 subroutine transpose(n,a,at)
9159 double precision a(n,n),at(n,n)
9167 C---------------------------------------------------------------------------
9168 subroutine prodmat3(a1,a2,kk,transp,prod)
9171 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9173 crc double precision auxmat(2,2),prod_(2,2)
9176 crc call transpose2(kk(1,1),auxmat(1,1))
9177 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9178 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9180 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9181 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9182 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9183 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9184 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9185 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9186 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9187 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9190 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9191 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9193 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9194 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9195 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9196 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9197 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9198 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9199 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9200 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9203 c call transpose2(a2(1,1),a2t(1,1))
9206 crc print *,((prod_(i,j),i=1,2),j=1,2)
9207 crc print *,((prod(i,j),i=1,2),j=1,2)
9211 C-----------------------------------------------------------------------------
9212 double precision function scalar(u,v)
9214 double precision u(3),v(3)