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) 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)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
160 if (isnan(etot).ne.0) energia(0)=1.0d+99
162 if (isnan(etot)) energia(0)=1.0d+99
167 idumm=proc_proc(etot,i)
169 call proc_proc(etot,i)
171 if(i.eq.1)energia(0)=1.0d+99
178 C Sum up the components of the Cartesian gradient.
183 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
184 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
186 & wstrain*ghpbc(j,i)+
187 & wcorr*fact(3)*gradcorr(j,i)+
188 & wel_loc*fact(2)*gel_loc(j,i)+
189 & wturn3*fact(2)*gcorr3_turn(j,i)+
190 & wturn4*fact(3)*gcorr4_turn(j,i)+
191 & wcorr5*fact(4)*gradcorr5(j,i)+
192 & wcorr6*fact(5)*gradcorr6(j,i)+
193 & wturn6*fact(5)*gcorr6_turn(j,i)+
194 & wsccor*fact(2)*gsccorc(j,i)
195 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
197 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
198 & wsccor*fact(2)*gsccorx(j,i)
203 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
204 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
206 & wcorr*fact(3)*gradcorr(j,i)+
207 & wel_loc*fact(2)*gel_loc(j,i)+
208 & wturn3*fact(2)*gcorr3_turn(j,i)+
209 & wturn4*fact(3)*gcorr4_turn(j,i)+
210 & wcorr5*fact(4)*gradcorr5(j,i)+
211 & wcorr6*fact(5)*gradcorr6(j,i)+
212 & wturn6*fact(5)*gcorr6_turn(j,i)+
213 & wsccor*fact(2)*gsccorc(j,i)
214 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
216 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
217 & wsccor*fact(1)*gsccorx(j,i)
224 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
225 & +wcorr5*fact(4)*g_corr5_loc(i)
226 & +wcorr6*fact(5)*g_corr6_loc(i)
227 & +wturn4*fact(3)*gel_loc_turn4(i)
228 & +wturn3*fact(2)*gel_loc_turn3(i)
229 & +wturn6*fact(5)*gel_loc_turn6(i)
230 & +wel_loc*fact(2)*gel_loc_loc(i)
235 C------------------------------------------------------------------------
236 subroutine enerprint(energia,fact)
237 implicit real*8 (a-h,o-z)
239 include 'DIMENSIONS.ZSCOPT'
240 include 'COMMON.IOUNITS'
241 include 'COMMON.FFIELD'
242 include 'COMMON.SBRIDGE'
243 double precision energia(0:max_ene),fact(6)
245 evdw=energia(1)+fact(6)*energia(21)
247 evdw2=energia(2)+energia(17)
259 eello_turn3=energia(8)
260 eello_turn4=energia(9)
261 eello_turn6=energia(10)
268 edihcnstr=energia(20)
271 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
273 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
274 & etors_d,wtor_d*fact(2),ehpb,wstrain,
275 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
276 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
277 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
278 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
279 10 format (/'Virtual-chain energies:'//
280 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
281 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
282 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
283 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
284 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
285 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
286 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
287 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
288 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
289 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
290 & ' (SS bridges & dist. cnstr.)'/
291 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
292 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
293 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
295 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
296 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
297 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
298 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
299 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
300 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
301 & 'ETOT= ',1pE16.6,' (total)')
303 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
304 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
305 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
306 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
307 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
308 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
309 & edihcnstr,ebr*nss,etot
310 10 format (/'Virtual-chain energies:'//
311 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
312 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
313 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
314 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
315 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
316 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
317 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
318 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
319 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
320 & ' (SS bridges & dist. cnstr.)'/
321 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
322 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
323 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
325 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
326 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
327 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
328 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
329 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
330 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
331 & 'ETOT= ',1pE16.6,' (total)')
335 C-----------------------------------------------------------------------
336 subroutine elj(evdw,evdw_t)
338 C This subroutine calculates the interaction energy of nonbonded side chains
339 C assuming the LJ potential of interaction.
341 implicit real*8 (a-h,o-z)
343 include 'DIMENSIONS.ZSCOPT'
344 include "DIMENSIONS.COMPAR"
345 parameter (accur=1.0d-10)
348 include 'COMMON.LOCAL'
349 include 'COMMON.CHAIN'
350 include 'COMMON.DERIV'
351 include 'COMMON.INTERACT'
352 include 'COMMON.TORSION'
353 include 'COMMON.ENEPS'
354 include 'COMMON.SBRIDGE'
355 include 'COMMON.NAMES'
356 include 'COMMON.IOUNITS'
357 include 'COMMON.CONTACTS'
361 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
364 eneps_temp(j,i)=0.0d0
371 if (itypi.eq.ntyp1) cycle
372 itypi1=iabs(itype(i+1))
379 C Calculate SC interaction energy.
382 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
383 cd & 'iend=',iend(i,iint)
384 do j=istart(i,iint),iend(i,iint)
386 if (itypj.eq.ntyp1) cycle
390 C Change 12/1/95 to calculate four-body interactions
391 rij=xj*xj+yj*yj+zj*zj
393 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
394 eps0ij=eps(itypi,itypj)
396 e1=fac*fac*aa(itypi,itypj)
397 e2=fac*bb(itypi,itypj)
399 ij=icant(itypi,itypj)
400 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
401 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
402 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
403 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
404 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
405 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
406 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
407 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
408 if (bb(itypi,itypj).gt.0.0d0) then
415 C Calculate the components of the gradient in DC and X
417 fac=-rrij*(e1+evdwij)
422 gvdwx(k,i)=gvdwx(k,i)-gg(k)
423 gvdwx(k,j)=gvdwx(k,j)+gg(k)
427 gvdwc(l,k)=gvdwc(l,k)+gg(l)
432 C 12/1/95, revised on 5/20/97
434 C Calculate the contact function. The ith column of the array JCONT will
435 C contain the numbers of atoms that make contacts with the atom I (of numbers
436 C greater than I). The arrays FACONT and GACONT will contain the values of
437 C the contact function and its derivative.
439 C Uncomment next line, if the correlation interactions include EVDW explicitly.
440 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
441 C Uncomment next line, if the correlation interactions are contact function only
442 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
444 sigij=sigma(itypi,itypj)
445 r0ij=rs0(itypi,itypj)
447 C Check whether the SC's are not too far to make a contact.
450 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
451 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
453 if (fcont.gt.0.0D0) then
454 C If the SC-SC distance if close to sigma, apply spline.
455 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
456 cAdam & fcont1,fprimcont1)
457 cAdam fcont1=1.0d0-fcont1
458 cAdam if (fcont1.gt.0.0d0) then
459 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
460 cAdam fcont=fcont*fcont1
462 C Uncomment following 4 lines to have the geometric average of the epsilon0's
463 cga eps0ij=1.0d0/dsqrt(eps0ij)
465 cga gg(k)=gg(k)*eps0ij
467 cga eps0ij=-evdwij*eps0ij
468 C Uncomment for AL's type of SC correlation interactions.
470 num_conti=num_conti+1
472 facont(num_conti,i)=fcont*eps0ij
473 fprimcont=eps0ij*fprimcont/rij
475 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
476 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
477 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
478 C Uncomment following 3 lines for Skolnick's type of SC correlation.
479 gacont(1,num_conti,i)=-fprimcont*xj
480 gacont(2,num_conti,i)=-fprimcont*yj
481 gacont(3,num_conti,i)=-fprimcont*zj
482 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
483 cd write (iout,'(2i3,3f10.5)')
484 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
490 num_cont(i)=num_conti
495 gvdwc(j,i)=expon*gvdwc(j,i)
496 gvdwx(j,i)=expon*gvdwx(j,i)
500 C******************************************************************************
504 C To save time, the factor of EXPON has been extracted from ALL components
505 C of GVDWC and GRADX. Remember to multiply them by this factor before further
508 C******************************************************************************
511 C-----------------------------------------------------------------------------
512 subroutine eljk(evdw,evdw_t)
514 C This subroutine calculates the interaction energy of nonbonded side chains
515 C assuming the LJK potential of interaction.
517 implicit real*8 (a-h,o-z)
519 include 'DIMENSIONS.ZSCOPT'
520 include "DIMENSIONS.COMPAR"
523 include 'COMMON.LOCAL'
524 include 'COMMON.CHAIN'
525 include 'COMMON.DERIV'
526 include 'COMMON.INTERACT'
527 include 'COMMON.ENEPS'
528 include 'COMMON.IOUNITS'
529 include 'COMMON.NAMES'
534 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
537 eneps_temp(j,i)=0.0d0
544 if (itypi.eq.ntyp1) cycle
545 itypi1=iabs(itype(i+1))
550 C Calculate SC interaction energy.
553 do j=istart(i,iint),iend(i,iint)
555 if (itypj.eq.ntyp1) cycle
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
657 if (itypi.eq.ntyp1) cycle
658 itypi1=iabs(itype(i+1))
662 dxi=dc_norm(1,nres+i)
663 dyi=dc_norm(2,nres+i)
664 dzi=dc_norm(3,nres+i)
665 dsci_inv=vbld_inv(i+nres)
667 C Calculate SC interaction energy.
670 do j=istart(i,iint),iend(i,iint)
673 if (itypj.eq.ntyp1) cycle
674 dscj_inv=vbld_inv(j+nres)
675 chi1=chi(itypi,itypj)
676 chi2=chi(itypj,itypi)
683 alf12=0.5D0*(alf1+alf2)
684 C For diagnostics only!!!
697 dxj=dc_norm(1,nres+j)
698 dyj=dc_norm(2,nres+j)
699 dzj=dc_norm(3,nres+j)
700 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
701 cd if (icall.eq.0) then
707 C Calculate the angle-dependent terms of energy & contributions to derivatives.
709 C Calculate whole angle-dependent part of epsilon and contributions
711 fac=(rrij*sigsq)**expon2
712 e1=fac*fac*aa(itypi,itypj)
713 e2=fac*bb(itypi,itypj)
714 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
715 eps2der=evdwij*eps3rt
716 eps3der=evdwij*eps2rt
717 evdwij=evdwij*eps2rt*eps3rt
718 ij=icant(itypi,itypj)
719 aux=eps1*eps2rt**2*eps3rt**2
720 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
721 & /dabs(eps(itypi,itypj))
722 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
723 if (bb(itypi,itypj).gt.0.0d0) then
730 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
731 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
732 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
733 & restyp(itypi),i,restyp(itypj),j,
734 & epsi,sigm,chi1,chi2,chip1,chip2,
735 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
736 & om1,om2,om12,1.0D0/dsqrt(rrij),
739 C Calculate gradient components.
740 e1=e1*eps1*eps2rt**2*eps3rt**2
741 fac=-expon*(e1+evdwij)
744 C Calculate radial part of the gradient
748 C Calculate the angular part of the gradient and sum add the contributions
749 C to the appropriate components of the Cartesian gradient.
758 C-----------------------------------------------------------------------------
759 subroutine egb(evdw,evdw_t)
761 C This subroutine calculates the interaction energy of nonbonded side chains
762 C assuming the Gay-Berne potential of interaction.
764 implicit real*8 (a-h,o-z)
766 include 'DIMENSIONS.ZSCOPT'
767 include "DIMENSIONS.COMPAR"
770 include 'COMMON.LOCAL'
771 include 'COMMON.CHAIN'
772 include 'COMMON.DERIV'
773 include 'COMMON.NAMES'
774 include 'COMMON.INTERACT'
775 include 'COMMON.ENEPS'
776 include 'COMMON.IOUNITS'
777 include 'COMMON.CALC'
784 eneps_temp(j,i)=0.0d0
787 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
791 c if (icall.gt.0) lprn=.true.
795 if (itypi.eq.ntyp1) cycle
796 itypi1=iabs(itype(i+1))
800 dxi=dc_norm(1,nres+i)
801 dyi=dc_norm(2,nres+i)
802 dzi=dc_norm(3,nres+i)
803 dsci_inv=vbld_inv(i+nres)
805 C Calculate SC interaction energy.
808 do j=istart(i,iint),iend(i,iint)
811 if (itypj.eq.ntyp1) cycle
812 dscj_inv=vbld_inv(j+nres)
813 sig0ij=sigma(itypi,itypj)
814 chi1=chi(itypi,itypj)
815 chi2=chi(itypj,itypi)
822 alf12=0.5D0*(alf1+alf2)
823 C For diagnostics only!!!
836 dxj=dc_norm(1,nres+j)
837 dyj=dc_norm(2,nres+j)
838 dzj=dc_norm(3,nres+j)
839 c write (iout,*) i,j,xj,yj,zj
840 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
842 C Calculate angle-dependent terms of energy and contributions to their
846 sig=sig0ij*dsqrt(sigsq)
847 rij_shift=1.0D0/rij-sig+sig0ij
848 C I hate to put IF's in the loops, but here don't have another choice!!!!
849 if (rij_shift.le.0.0D0) then
854 c---------------------------------------------------------------
855 rij_shift=1.0D0/rij_shift
857 e1=fac*fac*aa(itypi,itypj)
858 e2=fac*bb(itypi,itypj)
859 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
860 eps2der=evdwij*eps3rt
861 eps3der=evdwij*eps2rt
862 evdwij=evdwij*eps2rt*eps3rt
863 if (bb(itypi,itypj).gt.0) then
868 ij=icant(itypi,itypj)
869 aux=eps1*eps2rt**2*eps3rt**2
870 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
871 & /dabs(eps(itypi,itypj))
872 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
873 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
874 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
875 c & aux*e2/eps(itypi,itypj)
877 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
878 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
880 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
881 & restyp(itypi),i,restyp(itypj),j,
882 & epsi,sigm,chi1,chi2,chip1,chip2,
883 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
884 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
886 write (iout,*) "partial sum", evdw, evdw_t
890 C Calculate gradient components.
891 e1=e1*eps1*eps2rt**2*eps3rt**2
892 fac=-expon*(e1+evdwij)*rij_shift
895 C Calculate the radial part of the gradient
899 C Calculate angular part of the gradient.
907 C-----------------------------------------------------------------------------
908 subroutine egbv(evdw,evdw_t)
910 C This subroutine calculates the interaction energy of nonbonded side chains
911 C assuming the Gay-Berne-Vorobjev potential of interaction.
913 implicit real*8 (a-h,o-z)
915 include 'DIMENSIONS.ZSCOPT'
916 include "DIMENSIONS.COMPAR"
919 include 'COMMON.LOCAL'
920 include 'COMMON.CHAIN'
921 include 'COMMON.DERIV'
922 include 'COMMON.NAMES'
923 include 'COMMON.INTERACT'
924 include 'COMMON.ENEPS'
925 include 'COMMON.IOUNITS'
926 include 'COMMON.CALC'
933 eneps_temp(j,i)=0.0d0
938 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
941 c if (icall.gt.0) lprn=.true.
945 if (itypi.eq.ntyp1) cycle
946 itypi1=iabs(itype(i+1))
950 dxi=dc_norm(1,nres+i)
951 dyi=dc_norm(2,nres+i)
952 dzi=dc_norm(3,nres+i)
953 dsci_inv=vbld_inv(i+nres)
955 C Calculate SC interaction energy.
958 do j=istart(i,iint),iend(i,iint)
961 if (itypj.eq.ntyp1) cycle
962 dscj_inv=vbld_inv(j+nres)
963 sig0ij=sigma(itypi,itypj)
965 chi1=chi(itypi,itypj)
966 chi2=chi(itypj,itypi)
973 alf12=0.5D0*(alf1+alf2)
974 C For diagnostics only!!!
987 dxj=dc_norm(1,nres+j)
988 dyj=dc_norm(2,nres+j)
989 dzj=dc_norm(3,nres+j)
990 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
992 C Calculate angle-dependent terms of energy and contributions to their
996 sig=sig0ij*dsqrt(sigsq)
997 rij_shift=1.0D0/rij-sig+r0ij
998 C I hate to put IF's in the loops, but here don't have another choice!!!!
999 if (rij_shift.le.0.0D0) then
1004 c---------------------------------------------------------------
1005 rij_shift=1.0D0/rij_shift
1006 fac=rij_shift**expon
1007 e1=fac*fac*aa(itypi,itypj)
1008 e2=fac*bb(itypi,itypj)
1009 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1010 eps2der=evdwij*eps3rt
1011 eps3der=evdwij*eps2rt
1012 fac_augm=rrij**expon
1013 e_augm=augm(itypi,itypj)*fac_augm
1014 evdwij=evdwij*eps2rt*eps3rt
1015 if (bb(itypi,itypj).gt.0.0d0) then
1016 evdw=evdw+evdwij+e_augm
1018 evdw_t=evdw_t+evdwij+e_augm
1020 ij=icant(itypi,itypj)
1021 aux=eps1*eps2rt**2*eps3rt**2
1022 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1023 & /dabs(eps(itypi,itypj))
1024 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1025 c eneps_temp(ij)=eneps_temp(ij)
1026 c & +(evdwij+e_augm)/eps(itypi,itypj)
1028 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1029 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1030 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1031 c & restyp(itypi),i,restyp(itypj),j,
1032 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1033 c & chi1,chi2,chip1,chip2,
1034 c & eps1,eps2rt**2,eps3rt**2,
1035 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1039 C Calculate gradient components.
1040 e1=e1*eps1*eps2rt**2*eps3rt**2
1041 fac=-expon*(e1+evdwij)*rij_shift
1043 fac=rij*fac-2*expon*rrij*e_augm
1044 C Calculate the radial part of the gradient
1048 C Calculate angular part of the gradient.
1056 C-----------------------------------------------------------------------------
1057 subroutine sc_angular
1058 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1059 C om12. Called by ebp, egb, and egbv.
1061 include 'COMMON.CALC'
1065 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1066 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1067 om12=dxi*dxj+dyi*dyj+dzi*dzj
1069 C Calculate eps1(om12) and its derivative in om12
1070 faceps1=1.0D0-om12*chiom12
1071 faceps1_inv=1.0D0/faceps1
1072 eps1=dsqrt(faceps1_inv)
1073 C Following variable is eps1*deps1/dom12
1074 eps1_om12=faceps1_inv*chiom12
1075 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1080 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1081 sigsq=1.0D0-facsig*faceps1_inv
1082 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1083 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1084 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1085 C Calculate eps2 and its derivatives in om1, om2, and om12.
1088 chipom12=chip12*om12
1089 facp=1.0D0-om12*chipom12
1091 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1092 C Following variable is the square root of eps2
1093 eps2rt=1.0D0-facp1*facp_inv
1094 C Following three variables are the derivatives of the square root of eps
1095 C in om1, om2, and om12.
1096 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1097 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1098 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1099 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1100 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1101 C Calculate whole angle-dependent part of epsilon and contributions
1102 C to its derivatives
1105 C----------------------------------------------------------------------------
1107 implicit real*8 (a-h,o-z)
1108 include 'DIMENSIONS'
1109 include 'DIMENSIONS.ZSCOPT'
1110 include 'COMMON.CHAIN'
1111 include 'COMMON.DERIV'
1112 include 'COMMON.CALC'
1113 double precision dcosom1(3),dcosom2(3)
1114 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1115 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1116 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1117 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1119 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1120 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1123 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1126 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1127 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1128 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1129 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1130 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1131 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1134 C Calculate the components of the gradient in DC and X
1138 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1143 c------------------------------------------------------------------------------
1144 subroutine vec_and_deriv
1145 implicit real*8 (a-h,o-z)
1146 include 'DIMENSIONS'
1147 include 'DIMENSIONS.ZSCOPT'
1148 include 'COMMON.IOUNITS'
1149 include 'COMMON.GEO'
1150 include 'COMMON.VAR'
1151 include 'COMMON.LOCAL'
1152 include 'COMMON.CHAIN'
1153 include 'COMMON.VECTORS'
1154 include 'COMMON.DERIV'
1155 include 'COMMON.INTERACT'
1156 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1157 C Compute the local reference systems. For reference system (i), the
1158 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1159 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1161 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1162 if (i.eq.nres-1) then
1163 C Case of the last full residue
1164 C Compute the Z-axis
1165 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1166 costh=dcos(pi-theta(nres))
1167 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1172 C Compute the derivatives of uz
1174 uzder(2,1,1)=-dc_norm(3,i-1)
1175 uzder(3,1,1)= dc_norm(2,i-1)
1176 uzder(1,2,1)= dc_norm(3,i-1)
1178 uzder(3,2,1)=-dc_norm(1,i-1)
1179 uzder(1,3,1)=-dc_norm(2,i-1)
1180 uzder(2,3,1)= dc_norm(1,i-1)
1183 uzder(2,1,2)= dc_norm(3,i)
1184 uzder(3,1,2)=-dc_norm(2,i)
1185 uzder(1,2,2)=-dc_norm(3,i)
1187 uzder(3,2,2)= dc_norm(1,i)
1188 uzder(1,3,2)= dc_norm(2,i)
1189 uzder(2,3,2)=-dc_norm(1,i)
1192 C Compute the Y-axis
1195 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1198 C Compute the derivatives of uy
1201 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1202 & -dc_norm(k,i)*dc_norm(j,i-1)
1203 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1205 uyder(j,j,1)=uyder(j,j,1)-costh
1206 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1211 uygrad(l,k,j,i)=uyder(l,k,j)
1212 uzgrad(l,k,j,i)=uzder(l,k,j)
1216 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1217 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1218 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1219 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1223 C Compute the Z-axis
1224 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1225 costh=dcos(pi-theta(i+2))
1226 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1231 C Compute the derivatives of uz
1233 uzder(2,1,1)=-dc_norm(3,i+1)
1234 uzder(3,1,1)= dc_norm(2,i+1)
1235 uzder(1,2,1)= dc_norm(3,i+1)
1237 uzder(3,2,1)=-dc_norm(1,i+1)
1238 uzder(1,3,1)=-dc_norm(2,i+1)
1239 uzder(2,3,1)= dc_norm(1,i+1)
1242 uzder(2,1,2)= dc_norm(3,i)
1243 uzder(3,1,2)=-dc_norm(2,i)
1244 uzder(1,2,2)=-dc_norm(3,i)
1246 uzder(3,2,2)= dc_norm(1,i)
1247 uzder(1,3,2)= dc_norm(2,i)
1248 uzder(2,3,2)=-dc_norm(1,i)
1251 C Compute the Y-axis
1254 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1257 C Compute the derivatives of uy
1260 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1261 & -dc_norm(k,i)*dc_norm(j,i+1)
1262 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1264 uyder(j,j,1)=uyder(j,j,1)-costh
1265 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1270 uygrad(l,k,j,i)=uyder(l,k,j)
1271 uzgrad(l,k,j,i)=uzder(l,k,j)
1275 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1276 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1277 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1278 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1284 vbld_inv_temp(1)=vbld_inv(i+1)
1285 if (i.lt.nres-1) then
1286 vbld_inv_temp(2)=vbld_inv(i+2)
1288 vbld_inv_temp(2)=vbld_inv(i)
1293 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1294 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1302 C-----------------------------------------------------------------------------
1303 subroutine vec_and_deriv_test
1304 implicit real*8 (a-h,o-z)
1305 include 'DIMENSIONS'
1306 include 'DIMENSIONS.ZSCOPT'
1307 include 'COMMON.IOUNITS'
1308 include 'COMMON.GEO'
1309 include 'COMMON.VAR'
1310 include 'COMMON.LOCAL'
1311 include 'COMMON.CHAIN'
1312 include 'COMMON.VECTORS'
1313 dimension uyder(3,3,2),uzder(3,3,2)
1314 C Compute the local reference systems. For reference system (i), the
1315 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1316 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1318 if (i.eq.nres-1) then
1319 C Case of the last full residue
1320 C Compute the Z-axis
1321 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1322 costh=dcos(pi-theta(nres))
1323 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1324 c write (iout,*) 'fac',fac,
1325 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1326 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1330 C Compute the derivatives of uz
1332 uzder(2,1,1)=-dc_norm(3,i-1)
1333 uzder(3,1,1)= dc_norm(2,i-1)
1334 uzder(1,2,1)= dc_norm(3,i-1)
1336 uzder(3,2,1)=-dc_norm(1,i-1)
1337 uzder(1,3,1)=-dc_norm(2,i-1)
1338 uzder(2,3,1)= dc_norm(1,i-1)
1341 uzder(2,1,2)= dc_norm(3,i)
1342 uzder(3,1,2)=-dc_norm(2,i)
1343 uzder(1,2,2)=-dc_norm(3,i)
1345 uzder(3,2,2)= dc_norm(1,i)
1346 uzder(1,3,2)= dc_norm(2,i)
1347 uzder(2,3,2)=-dc_norm(1,i)
1349 C Compute the Y-axis
1351 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1354 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1355 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1356 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1358 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1361 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1362 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1365 c write (iout,*) 'facy',facy,
1366 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1367 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1369 uy(k,i)=facy*uy(k,i)
1371 C Compute the derivatives of uy
1374 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1375 & -dc_norm(k,i)*dc_norm(j,i-1)
1376 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1378 c uyder(j,j,1)=uyder(j,j,1)-costh
1379 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1380 uyder(j,j,1)=uyder(j,j,1)
1381 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1382 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1388 uygrad(l,k,j,i)=uyder(l,k,j)
1389 uzgrad(l,k,j,i)=uzder(l,k,j)
1393 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1394 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1395 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1396 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1399 C Compute the Z-axis
1400 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1401 costh=dcos(pi-theta(i+2))
1402 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1403 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1407 C Compute the derivatives of uz
1409 uzder(2,1,1)=-dc_norm(3,i+1)
1410 uzder(3,1,1)= dc_norm(2,i+1)
1411 uzder(1,2,1)= dc_norm(3,i+1)
1413 uzder(3,2,1)=-dc_norm(1,i+1)
1414 uzder(1,3,1)=-dc_norm(2,i+1)
1415 uzder(2,3,1)= dc_norm(1,i+1)
1418 uzder(2,1,2)= dc_norm(3,i)
1419 uzder(3,1,2)=-dc_norm(2,i)
1420 uzder(1,2,2)=-dc_norm(3,i)
1422 uzder(3,2,2)= dc_norm(1,i)
1423 uzder(1,3,2)= dc_norm(2,i)
1424 uzder(2,3,2)=-dc_norm(1,i)
1426 C Compute the Y-axis
1428 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1429 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1430 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1432 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1435 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1436 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1439 c write (iout,*) 'facy',facy,
1440 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1441 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1443 uy(k,i)=facy*uy(k,i)
1445 C Compute the derivatives of uy
1448 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1449 & -dc_norm(k,i)*dc_norm(j,i+1)
1450 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1452 c uyder(j,j,1)=uyder(j,j,1)-costh
1453 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1454 uyder(j,j,1)=uyder(j,j,1)
1455 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1456 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1462 uygrad(l,k,j,i)=uyder(l,k,j)
1463 uzgrad(l,k,j,i)=uzder(l,k,j)
1467 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1468 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1469 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1470 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1477 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1478 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1485 C-----------------------------------------------------------------------------
1486 subroutine check_vecgrad
1487 implicit real*8 (a-h,o-z)
1488 include 'DIMENSIONS'
1489 include 'DIMENSIONS.ZSCOPT'
1490 include 'COMMON.IOUNITS'
1491 include 'COMMON.GEO'
1492 include 'COMMON.VAR'
1493 include 'COMMON.LOCAL'
1494 include 'COMMON.CHAIN'
1495 include 'COMMON.VECTORS'
1496 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1497 dimension uyt(3,maxres),uzt(3,maxres)
1498 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1499 double precision delta /1.0d-7/
1502 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1503 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1504 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1505 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1506 cd & (dc_norm(if90,i),if90=1,3)
1507 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1508 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1509 cd write(iout,'(a)')
1515 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1516 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1529 cd write (iout,*) 'i=',i
1531 erij(k)=dc_norm(k,i)
1535 dc_norm(k,i)=erij(k)
1537 dc_norm(j,i)=dc_norm(j,i)+delta
1538 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1540 c dc_norm(k,i)=dc_norm(k,i)/fac
1542 c write (iout,*) (dc_norm(k,i),k=1,3)
1543 c write (iout,*) (erij(k),k=1,3)
1546 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1547 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1548 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1549 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1551 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1552 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1553 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1556 dc_norm(k,i)=erij(k)
1559 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1560 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1561 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1562 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1563 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1564 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1565 cd write (iout,'(a)')
1570 C--------------------------------------------------------------------------
1571 subroutine set_matrices
1572 implicit real*8 (a-h,o-z)
1573 include 'DIMENSIONS'
1574 include 'DIMENSIONS.ZSCOPT'
1575 include 'COMMON.IOUNITS'
1576 include 'COMMON.GEO'
1577 include 'COMMON.VAR'
1578 include 'COMMON.LOCAL'
1579 include 'COMMON.CHAIN'
1580 include 'COMMON.DERIV'
1581 include 'COMMON.INTERACT'
1582 include 'COMMON.CONTACTS'
1583 include 'COMMON.TORSION'
1584 include 'COMMON.VECTORS'
1585 include 'COMMON.FFIELD'
1586 double precision auxvec(2),auxmat(2,2)
1588 C Compute the virtual-bond-torsional-angle dependent quantities needed
1589 C to calculate the el-loc multibody terms of various order.
1592 if (i .lt. nres+1) then
1629 if (i .gt. 3 .and. i .lt. nres+1) then
1630 obrot_der(1,i-2)=-sin1
1631 obrot_der(2,i-2)= cos1
1632 Ugder(1,1,i-2)= sin1
1633 Ugder(1,2,i-2)=-cos1
1634 Ugder(2,1,i-2)=-cos1
1635 Ugder(2,2,i-2)=-sin1
1638 obrot2_der(1,i-2)=-dwasin2
1639 obrot2_der(2,i-2)= dwacos2
1640 Ug2der(1,1,i-2)= dwasin2
1641 Ug2der(1,2,i-2)=-dwacos2
1642 Ug2der(2,1,i-2)=-dwacos2
1643 Ug2der(2,2,i-2)=-dwasin2
1645 obrot_der(1,i-2)=0.0d0
1646 obrot_der(2,i-2)=0.0d0
1647 Ugder(1,1,i-2)=0.0d0
1648 Ugder(1,2,i-2)=0.0d0
1649 Ugder(2,1,i-2)=0.0d0
1650 Ugder(2,2,i-2)=0.0d0
1651 obrot2_der(1,i-2)=0.0d0
1652 obrot2_der(2,i-2)=0.0d0
1653 Ug2der(1,1,i-2)=0.0d0
1654 Ug2der(1,2,i-2)=0.0d0
1655 Ug2der(2,1,i-2)=0.0d0
1656 Ug2der(2,2,i-2)=0.0d0
1658 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1659 if (itype(i-2).le.ntyp) then
1660 iti = itortyp(itype(i-2))
1667 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1668 if (itype(i-1).le.ntyp) then
1669 iti1 = itortyp(itype(i-1))
1676 cd write (iout,*) '*******i',i,' iti1',iti
1677 cd write (iout,*) 'b1',b1(:,iti)
1678 cd write (iout,*) 'b2',b2(:,iti)
1679 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1680 c print *,"itilde1 i iti iti1",i,iti,iti1
1681 if (i .gt. iatel_s+2) then
1682 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1683 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1684 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1685 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1686 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1687 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1688 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1698 DtUg2(l,k,i-2)=0.0d0
1702 c print *,"itilde2 i iti iti1",i,iti,iti1
1703 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1704 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1705 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1706 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1707 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1708 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1709 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1710 c print *,"itilde3 i iti iti1",i,iti,iti1
1712 muder(k,i-2)=Ub2der(k,i-2)
1714 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1715 if (itype(i-1).le.ntyp) then
1716 iti1 = itortyp(itype(i-1))
1724 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1726 C Vectors and matrices dependent on a single virtual-bond dihedral.
1727 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1728 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1729 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1730 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1731 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1732 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1733 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1734 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1735 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1736 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1737 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1739 C Matrices dependent on two consecutive virtual-bond dihedrals.
1740 C The order of matrices is from left to right.
1742 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1743 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1744 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1745 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1746 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1747 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1748 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1749 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1752 cd iti = itortyp(itype(i))
1755 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1756 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1761 C--------------------------------------------------------------------------
1762 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1764 C This subroutine calculates the average interaction energy and its gradient
1765 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1766 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1767 C The potential depends both on the distance of peptide-group centers and on
1768 C the orientation of the CA-CA virtual bonds.
1770 implicit real*8 (a-h,o-z)
1771 include 'DIMENSIONS'
1772 include 'DIMENSIONS.ZSCOPT'
1773 include 'COMMON.CONTROL'
1774 include 'COMMON.IOUNITS'
1775 include 'COMMON.GEO'
1776 include 'COMMON.VAR'
1777 include 'COMMON.LOCAL'
1778 include 'COMMON.CHAIN'
1779 include 'COMMON.DERIV'
1780 include 'COMMON.INTERACT'
1781 include 'COMMON.CONTACTS'
1782 include 'COMMON.TORSION'
1783 include 'COMMON.VECTORS'
1784 include 'COMMON.FFIELD'
1785 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1786 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1787 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1788 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1789 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1790 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1791 double precision scal_el /0.5d0/
1793 C 13-go grudnia roku pamietnego...
1794 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1795 & 0.0d0,1.0d0,0.0d0,
1796 & 0.0d0,0.0d0,1.0d0/
1797 cd write(iout,*) 'In EELEC'
1799 cd write(iout,*) 'Type',i
1800 cd write(iout,*) 'B1',B1(:,i)
1801 cd write(iout,*) 'B2',B2(:,i)
1802 cd write(iout,*) 'CC',CC(:,:,i)
1803 cd write(iout,*) 'DD',DD(:,:,i)
1804 cd write(iout,*) 'EE',EE(:,:,i)
1806 cd call check_vecgrad
1808 if (icheckgrad.eq.1) then
1810 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1812 dc_norm(k,i)=dc(k,i)*fac
1814 c write (iout,*) 'i',i,' fac',fac
1817 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1818 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1819 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1820 cd if (wel_loc.gt.0.0d0) then
1821 if (icheckgrad.eq.1) then
1822 call vec_and_deriv_test
1829 cd write (iout,*) 'i=',i
1831 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1834 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1835 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1848 cd print '(a)','Enter EELEC'
1849 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1851 gel_loc_loc(i)=0.0d0
1854 do i=iatel_s,iatel_e
1855 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1856 if (itel(i).eq.0) goto 1215
1860 dx_normi=dc_norm(1,i)
1861 dy_normi=dc_norm(2,i)
1862 dz_normi=dc_norm(3,i)
1863 xmedi=c(1,i)+0.5d0*dxi
1864 ymedi=c(2,i)+0.5d0*dyi
1865 zmedi=c(3,i)+0.5d0*dzi
1867 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1868 do j=ielstart(i),ielend(i)
1869 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1870 if (itel(j).eq.0) goto 1216
1874 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1875 aaa=app(iteli,itelj)
1876 bbb=bpp(iteli,itelj)
1877 C Diagnostics only!!!
1883 ael6i=ael6(iteli,itelj)
1884 ael3i=ael3(iteli,itelj)
1888 dx_normj=dc_norm(1,j)
1889 dy_normj=dc_norm(2,j)
1890 dz_normj=dc_norm(3,j)
1891 xj=c(1,j)+0.5D0*dxj-xmedi
1892 yj=c(2,j)+0.5D0*dyj-ymedi
1893 zj=c(3,j)+0.5D0*dzj-zmedi
1894 rij=xj*xj+yj*yj+zj*zj
1900 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1901 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1902 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1903 fac=cosa-3.0D0*cosb*cosg
1905 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1906 if (j.eq.i+2) ev1=scal_el*ev1
1911 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1914 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1915 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1916 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1919 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1920 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1921 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1922 cd & xmedi,ymedi,zmedi,xj,yj,zj
1924 C Calculate contributions to the Cartesian gradient.
1927 facvdw=-6*rrmij*(ev1+evdwij)
1928 facel=-3*rrmij*(el1+eesij)
1935 * Radial derivatives. First process both termini of the fragment (i,j)
1942 gelc(k,i)=gelc(k,i)+ghalf
1943 gelc(k,j)=gelc(k,j)+ghalf
1946 * Loop over residues i+1 thru j-1.
1950 gelc(l,k)=gelc(l,k)+ggg(l)
1958 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1959 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1962 * Loop over residues i+1 thru j-1.
1966 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1973 fac=-3*rrmij*(facvdw+facvdw+facel)
1979 * Radial derivatives. First process both termini of the fragment (i,j)
1986 gelc(k,i)=gelc(k,i)+ghalf
1987 gelc(k,j)=gelc(k,j)+ghalf
1990 * Loop over residues i+1 thru j-1.
1994 gelc(l,k)=gelc(l,k)+ggg(l)
2001 ecosa=2.0D0*fac3*fac1+fac4
2004 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2005 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2007 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2008 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2010 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2011 cd & (dcosg(k),k=1,3)
2013 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2017 gelc(k,i)=gelc(k,i)+ghalf
2018 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2019 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2020 gelc(k,j)=gelc(k,j)+ghalf
2021 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2022 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2026 gelc(l,k)=gelc(l,k)+ggg(l)
2031 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2032 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2033 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2035 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2036 C energy of a peptide unit is assumed in the form of a second-order
2037 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2038 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2039 C are computed for EVERY pair of non-contiguous peptide groups.
2041 if (j.lt.nres-1) then
2052 muij(kkk)=mu(k,i)*mu(l,j)
2055 cd write (iout,*) 'EELEC: i',i,' j',j
2056 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2057 cd write(iout,*) 'muij',muij
2058 ury=scalar(uy(1,i),erij)
2059 urz=scalar(uz(1,i),erij)
2060 vry=scalar(uy(1,j),erij)
2061 vrz=scalar(uz(1,j),erij)
2062 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2063 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2064 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2065 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2066 C For diagnostics only
2071 fac=dsqrt(-ael6i)*r3ij
2072 cd write (2,*) 'fac=',fac
2073 C For diagnostics only
2079 cd write (iout,'(4i5,4f10.5)')
2080 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2081 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2082 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2083 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2084 cd write (iout,'(4f10.5)')
2085 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2086 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2087 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2088 cd write (iout,'(2i3,9f10.5/)') i,j,
2089 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2091 C Derivatives of the elements of A in virtual-bond vectors
2092 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2099 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2100 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2101 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2102 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2103 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2104 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2105 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2106 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2107 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2108 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2109 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2110 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2120 C Compute radial contributions to the gradient
2142 C Add the contributions coming from er
2145 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2146 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2147 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2148 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2151 C Derivatives in DC(i)
2152 ghalf1=0.5d0*agg(k,1)
2153 ghalf2=0.5d0*agg(k,2)
2154 ghalf3=0.5d0*agg(k,3)
2155 ghalf4=0.5d0*agg(k,4)
2156 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2157 & -3.0d0*uryg(k,2)*vry)+ghalf1
2158 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2159 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2160 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2161 & -3.0d0*urzg(k,2)*vry)+ghalf3
2162 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2163 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2164 C Derivatives in DC(i+1)
2165 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2166 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2167 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2168 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2169 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2170 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2171 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2172 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2173 C Derivatives in DC(j)
2174 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2175 & -3.0d0*vryg(k,2)*ury)+ghalf1
2176 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2177 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2178 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2179 & -3.0d0*vryg(k,2)*urz)+ghalf3
2180 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2181 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2182 C Derivatives in DC(j+1) or DC(nres-1)
2183 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2184 & -3.0d0*vryg(k,3)*ury)
2185 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2186 & -3.0d0*vrzg(k,3)*ury)
2187 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2188 & -3.0d0*vryg(k,3)*urz)
2189 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2190 & -3.0d0*vrzg(k,3)*urz)
2195 C Derivatives in DC(i+1)
2196 cd aggi1(k,1)=agg(k,1)
2197 cd aggi1(k,2)=agg(k,2)
2198 cd aggi1(k,3)=agg(k,3)
2199 cd aggi1(k,4)=agg(k,4)
2200 C Derivatives in DC(j)
2205 C Derivatives in DC(j+1)
2210 if (j.eq.nres-1 .and. i.lt.j-2) then
2212 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2213 cd aggj1(k,l)=agg(k,l)
2219 C Check the loc-el terms by numerical integration
2229 aggi(k,l)=-aggi(k,l)
2230 aggi1(k,l)=-aggi1(k,l)
2231 aggj(k,l)=-aggj(k,l)
2232 aggj1(k,l)=-aggj1(k,l)
2235 if (j.lt.nres-1) then
2241 aggi(k,l)=-aggi(k,l)
2242 aggi1(k,l)=-aggi1(k,l)
2243 aggj(k,l)=-aggj(k,l)
2244 aggj1(k,l)=-aggj1(k,l)
2255 aggi(k,l)=-aggi(k,l)
2256 aggi1(k,l)=-aggi1(k,l)
2257 aggj(k,l)=-aggj(k,l)
2258 aggj1(k,l)=-aggj1(k,l)
2264 IF (wel_loc.gt.0.0d0) THEN
2265 C Contribution to the local-electrostatic energy coming from the i-j pair
2266 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2268 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2269 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2270 eel_loc=eel_loc+eel_loc_ij
2271 C Partial derivatives in virtual-bond dihedral angles gamma
2274 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2275 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2276 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2277 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2278 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2279 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2280 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2281 cd write(iout,*) 'agg ',agg
2282 cd write(iout,*) 'aggi ',aggi
2283 cd write(iout,*) 'aggi1',aggi1
2284 cd write(iout,*) 'aggj ',aggj
2285 cd write(iout,*) 'aggj1',aggj1
2287 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2289 ggg(l)=agg(l,1)*muij(1)+
2290 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2294 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2297 C Remaining derivatives of eello
2299 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2300 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2301 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2302 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2303 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2304 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2305 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2306 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2310 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2311 C Contributions from turns
2316 call eturn34(i,j,eello_turn3,eello_turn4)
2318 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2319 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2321 C Calculate the contact function. The ith column of the array JCONT will
2322 C contain the numbers of atoms that make contacts with the atom I (of numbers
2323 C greater than I). The arrays FACONT and GACONT will contain the values of
2324 C the contact function and its derivative.
2325 c r0ij=1.02D0*rpp(iteli,itelj)
2326 c r0ij=1.11D0*rpp(iteli,itelj)
2327 r0ij=2.20D0*rpp(iteli,itelj)
2328 c r0ij=1.55D0*rpp(iteli,itelj)
2329 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2330 if (fcont.gt.0.0D0) then
2331 num_conti=num_conti+1
2332 if (num_conti.gt.maxconts) then
2333 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2334 & ' will skip next contacts for this conf.'
2336 jcont_hb(num_conti,i)=j
2337 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2338 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2339 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2341 d_cont(num_conti,i)=rij
2342 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2343 C --- Electrostatic-interaction matrix ---
2344 a_chuj(1,1,num_conti,i)=a22
2345 a_chuj(1,2,num_conti,i)=a23
2346 a_chuj(2,1,num_conti,i)=a32
2347 a_chuj(2,2,num_conti,i)=a33
2348 C --- Gradient of rij
2350 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2353 c a_chuj(1,1,num_conti,i)=-0.61d0
2354 c a_chuj(1,2,num_conti,i)= 0.4d0
2355 c a_chuj(2,1,num_conti,i)= 0.65d0
2356 c a_chuj(2,2,num_conti,i)= 0.50d0
2357 c else if (i.eq.2) then
2358 c a_chuj(1,1,num_conti,i)= 0.0d0
2359 c a_chuj(1,2,num_conti,i)= 0.0d0
2360 c a_chuj(2,1,num_conti,i)= 0.0d0
2361 c a_chuj(2,2,num_conti,i)= 0.0d0
2363 C --- and its gradients
2364 cd write (iout,*) 'i',i,' j',j
2366 cd write (iout,*) 'iii 1 kkk',kkk
2367 cd write (iout,*) agg(kkk,:)
2370 cd write (iout,*) 'iii 2 kkk',kkk
2371 cd write (iout,*) aggi(kkk,:)
2374 cd write (iout,*) 'iii 3 kkk',kkk
2375 cd write (iout,*) aggi1(kkk,:)
2378 cd write (iout,*) 'iii 4 kkk',kkk
2379 cd write (iout,*) aggj(kkk,:)
2382 cd write (iout,*) 'iii 5 kkk',kkk
2383 cd write (iout,*) aggj1(kkk,:)
2390 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2391 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2392 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2393 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2394 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2396 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2402 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2403 C Calculate contact energies
2405 wij=cosa-3.0D0*cosb*cosg
2408 c fac3=dsqrt(-ael6i)/r0ij**3
2409 fac3=dsqrt(-ael6i)*r3ij
2410 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2411 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2413 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2414 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2415 C Diagnostics. Comment out or remove after debugging!
2416 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2417 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2418 c ees0m(num_conti,i)=0.0D0
2420 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2421 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2422 facont_hb(num_conti,i)=fcont
2424 C Angular derivatives of the contact function
2425 ees0pij1=fac3/ees0pij
2426 ees0mij1=fac3/ees0mij
2427 fac3p=-3.0D0*fac3*rrmij
2428 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2429 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2431 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2432 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2433 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2434 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2435 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2436 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2437 ecosap=ecosa1+ecosa2
2438 ecosbp=ecosb1+ecosb2
2439 ecosgp=ecosg1+ecosg2
2440 ecosam=ecosa1-ecosa2
2441 ecosbm=ecosb1-ecosb2
2442 ecosgm=ecosg1-ecosg2
2451 fprimcont=fprimcont/rij
2452 cd facont_hb(num_conti,i)=1.0D0
2453 C Following line is for diagnostics.
2456 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2457 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2460 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2461 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2463 gggp(1)=gggp(1)+ees0pijp*xj
2464 gggp(2)=gggp(2)+ees0pijp*yj
2465 gggp(3)=gggp(3)+ees0pijp*zj
2466 gggm(1)=gggm(1)+ees0mijp*xj
2467 gggm(2)=gggm(2)+ees0mijp*yj
2468 gggm(3)=gggm(3)+ees0mijp*zj
2469 C Derivatives due to the contact function
2470 gacont_hbr(1,num_conti,i)=fprimcont*xj
2471 gacont_hbr(2,num_conti,i)=fprimcont*yj
2472 gacont_hbr(3,num_conti,i)=fprimcont*zj
2474 ghalfp=0.5D0*gggp(k)
2475 ghalfm=0.5D0*gggm(k)
2476 gacontp_hb1(k,num_conti,i)=ghalfp
2477 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2478 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2479 gacontp_hb2(k,num_conti,i)=ghalfp
2480 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2481 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2482 gacontp_hb3(k,num_conti,i)=gggp(k)
2483 gacontm_hb1(k,num_conti,i)=ghalfm
2484 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2485 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2486 gacontm_hb2(k,num_conti,i)=ghalfm
2487 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2488 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2489 gacontm_hb3(k,num_conti,i)=gggm(k)
2492 C Diagnostics. Comment out or remove after debugging!
2494 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2495 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2496 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2497 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2498 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2499 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2502 endif ! num_conti.le.maxconts
2507 num_cont_hb(i)=num_conti
2511 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2512 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2514 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2515 ccc eel_loc=eel_loc+eello_turn3
2518 C-----------------------------------------------------------------------------
2519 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2520 C Third- and fourth-order contributions from turns
2521 implicit real*8 (a-h,o-z)
2522 include 'DIMENSIONS'
2523 include 'DIMENSIONS.ZSCOPT'
2524 include 'COMMON.IOUNITS'
2525 include 'COMMON.GEO'
2526 include 'COMMON.VAR'
2527 include 'COMMON.LOCAL'
2528 include 'COMMON.CHAIN'
2529 include 'COMMON.DERIV'
2530 include 'COMMON.INTERACT'
2531 include 'COMMON.CONTACTS'
2532 include 'COMMON.TORSION'
2533 include 'COMMON.VECTORS'
2534 include 'COMMON.FFIELD'
2536 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2537 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2538 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2539 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2540 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2541 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2543 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2545 C Third-order contributions
2552 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2553 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2554 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2555 call transpose2(auxmat(1,1),auxmat1(1,1))
2556 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2557 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2558 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2559 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2560 cd & ' eello_turn3_num',4*eello_turn3_num
2562 C Derivatives in gamma(i)
2563 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2564 call transpose2(auxmat2(1,1),pizda(1,1))
2565 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2566 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2567 C Derivatives in gamma(i+1)
2568 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2569 call transpose2(auxmat2(1,1),pizda(1,1))
2570 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2571 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2572 & +0.5d0*(pizda(1,1)+pizda(2,2))
2573 C Cartesian derivatives
2575 a_temp(1,1)=aggi(l,1)
2576 a_temp(1,2)=aggi(l,2)
2577 a_temp(2,1)=aggi(l,3)
2578 a_temp(2,2)=aggi(l,4)
2579 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2580 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2581 & +0.5d0*(pizda(1,1)+pizda(2,2))
2582 a_temp(1,1)=aggi1(l,1)
2583 a_temp(1,2)=aggi1(l,2)
2584 a_temp(2,1)=aggi1(l,3)
2585 a_temp(2,2)=aggi1(l,4)
2586 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2587 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2588 & +0.5d0*(pizda(1,1)+pizda(2,2))
2589 a_temp(1,1)=aggj(l,1)
2590 a_temp(1,2)=aggj(l,2)
2591 a_temp(2,1)=aggj(l,3)
2592 a_temp(2,2)=aggj(l,4)
2593 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2594 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2595 & +0.5d0*(pizda(1,1)+pizda(2,2))
2596 a_temp(1,1)=aggj1(l,1)
2597 a_temp(1,2)=aggj1(l,2)
2598 a_temp(2,1)=aggj1(l,3)
2599 a_temp(2,2)=aggj1(l,4)
2600 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2601 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2602 & +0.5d0*(pizda(1,1)+pizda(2,2))
2605 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2606 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2608 C Fourth-order contributions
2616 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2617 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2618 iti1=itortyp(itype(i+1))
2619 iti2=itortyp(itype(i+2))
2620 iti3=itortyp(itype(i+3))
2621 call transpose2(EUg(1,1,i+1),e1t(1,1))
2622 call transpose2(Eug(1,1,i+2),e2t(1,1))
2623 call transpose2(Eug(1,1,i+3),e3t(1,1))
2624 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2625 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2626 s1=scalar2(b1(1,iti2),auxvec(1))
2627 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2628 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2629 s2=scalar2(b1(1,iti1),auxvec(1))
2630 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2631 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2632 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2633 eello_turn4=eello_turn4-(s1+s2+s3)
2634 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2635 cd & ' eello_turn4_num',8*eello_turn4_num
2636 C Derivatives in gamma(i)
2638 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2639 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2640 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2641 s1=scalar2(b1(1,iti2),auxvec(1))
2642 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2643 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2644 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2645 C Derivatives in gamma(i+1)
2646 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2647 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2648 s2=scalar2(b1(1,iti1),auxvec(1))
2649 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2650 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2651 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2652 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2653 C Derivatives in gamma(i+2)
2654 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2655 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2656 s1=scalar2(b1(1,iti2),auxvec(1))
2657 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2658 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2659 s2=scalar2(b1(1,iti1),auxvec(1))
2660 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2661 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2662 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2663 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2664 C Cartesian derivatives
2665 C Derivatives of this turn contributions in DC(i+2)
2666 if (j.lt.nres-1) then
2668 a_temp(1,1)=agg(l,1)
2669 a_temp(1,2)=agg(l,2)
2670 a_temp(2,1)=agg(l,3)
2671 a_temp(2,2)=agg(l,4)
2672 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2673 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2674 s1=scalar2(b1(1,iti2),auxvec(1))
2675 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2676 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2677 s2=scalar2(b1(1,iti1),auxvec(1))
2678 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2679 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2680 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2682 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2685 C Remaining derivatives of this turn contribution
2687 a_temp(1,1)=aggi(l,1)
2688 a_temp(1,2)=aggi(l,2)
2689 a_temp(2,1)=aggi(l,3)
2690 a_temp(2,2)=aggi(l,4)
2691 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2692 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2693 s1=scalar2(b1(1,iti2),auxvec(1))
2694 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2695 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2696 s2=scalar2(b1(1,iti1),auxvec(1))
2697 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2698 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2699 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2700 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2701 a_temp(1,1)=aggi1(l,1)
2702 a_temp(1,2)=aggi1(l,2)
2703 a_temp(2,1)=aggi1(l,3)
2704 a_temp(2,2)=aggi1(l,4)
2705 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2706 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2707 s1=scalar2(b1(1,iti2),auxvec(1))
2708 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2709 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2710 s2=scalar2(b1(1,iti1),auxvec(1))
2711 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2712 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2713 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2714 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2715 a_temp(1,1)=aggj(l,1)
2716 a_temp(1,2)=aggj(l,2)
2717 a_temp(2,1)=aggj(l,3)
2718 a_temp(2,2)=aggj(l,4)
2719 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2720 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2721 s1=scalar2(b1(1,iti2),auxvec(1))
2722 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2723 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2724 s2=scalar2(b1(1,iti1),auxvec(1))
2725 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2726 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2727 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2728 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2729 a_temp(1,1)=aggj1(l,1)
2730 a_temp(1,2)=aggj1(l,2)
2731 a_temp(2,1)=aggj1(l,3)
2732 a_temp(2,2)=aggj1(l,4)
2733 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2734 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2735 s1=scalar2(b1(1,iti2),auxvec(1))
2736 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2737 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2738 s2=scalar2(b1(1,iti1),auxvec(1))
2739 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2740 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2741 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2742 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2748 C-----------------------------------------------------------------------------
2749 subroutine vecpr(u,v,w)
2750 implicit real*8(a-h,o-z)
2751 dimension u(3),v(3),w(3)
2752 w(1)=u(2)*v(3)-u(3)*v(2)
2753 w(2)=-u(1)*v(3)+u(3)*v(1)
2754 w(3)=u(1)*v(2)-u(2)*v(1)
2757 C-----------------------------------------------------------------------------
2758 subroutine unormderiv(u,ugrad,unorm,ungrad)
2759 C This subroutine computes the derivatives of a normalized vector u, given
2760 C the derivatives computed without normalization conditions, ugrad. Returns
2763 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2764 double precision vec(3)
2765 double precision scalar
2767 c write (2,*) 'ugrad',ugrad
2770 vec(i)=scalar(ugrad(1,i),u(1))
2772 c write (2,*) 'vec',vec
2775 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2778 c write (2,*) 'ungrad',ungrad
2781 C-----------------------------------------------------------------------------
2782 subroutine escp(evdw2,evdw2_14)
2784 C This subroutine calculates the excluded-volume interaction energy between
2785 C peptide-group centers and side chains and its gradient in virtual-bond and
2786 C side-chain vectors.
2788 implicit real*8 (a-h,o-z)
2789 include 'DIMENSIONS'
2790 include 'DIMENSIONS.ZSCOPT'
2791 include 'COMMON.GEO'
2792 include 'COMMON.VAR'
2793 include 'COMMON.LOCAL'
2794 include 'COMMON.CHAIN'
2795 include 'COMMON.DERIV'
2796 include 'COMMON.INTERACT'
2797 include 'COMMON.FFIELD'
2798 include 'COMMON.IOUNITS'
2802 cd print '(a)','Enter ESCP'
2803 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2804 c & ' scal14',scal14
2805 do i=iatscp_s,iatscp_e
2806 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2808 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2809 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2810 if (iteli.eq.0) goto 1225
2811 xi=0.5D0*(c(1,i)+c(1,i+1))
2812 yi=0.5D0*(c(2,i)+c(2,i+1))
2813 zi=0.5D0*(c(3,i)+c(3,i+1))
2815 do iint=1,nscp_gr(i)
2817 do j=iscpstart(i,iint),iscpend(i,iint)
2818 itypj=iabs(itype(j))
2819 if (itypj.eq.ntyp1) cycle
2820 C Uncomment following three lines for SC-p interactions
2824 C Uncomment following three lines for Ca-p interactions
2828 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2830 e1=fac*fac*aad(itypj,iteli)
2831 e2=fac*bad(itypj,iteli)
2832 if (iabs(j-i) .le. 2) then
2835 evdw2_14=evdw2_14+e1+e2
2838 c write (iout,*) i,j,evdwij
2842 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2844 fac=-(evdwij+e1)*rrij
2849 cd write (iout,*) 'j<i'
2850 C Uncomment following three lines for SC-p interactions
2852 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2855 cd write (iout,*) 'j>i'
2858 C Uncomment following line for SC-p interactions
2859 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2863 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2867 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2868 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2871 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2881 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2882 gradx_scp(j,i)=expon*gradx_scp(j,i)
2885 C******************************************************************************
2889 C To save time the factor EXPON has been extracted from ALL components
2890 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2893 C******************************************************************************
2896 C--------------------------------------------------------------------------
2897 subroutine edis(ehpb)
2899 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2901 implicit real*8 (a-h,o-z)
2902 include 'DIMENSIONS'
2903 include 'DIMENSIONS.ZSCOPT'
2904 include 'COMMON.SBRIDGE'
2905 include 'COMMON.CHAIN'
2906 include 'COMMON.DERIV'
2907 include 'COMMON.VAR'
2908 include 'COMMON.INTERACT'
2911 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2912 cd print *,'link_start=',link_start,' link_end=',link_end
2913 if (link_end.eq.0) return
2914 do i=link_start,link_end
2915 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2916 C CA-CA distance used in regularization of structure.
2919 C iii and jjj point to the residues for which the distance is assigned.
2920 if (ii.gt.nres) then
2927 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2928 C distance and angle dependent SS bond potential.
2929 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2930 & iabs(itype(jjj)).eq.1) then
2931 call ssbond_ene(iii,jjj,eij)
2934 C Calculate the distance between the two points and its difference from the
2938 C Get the force constant corresponding to this distance.
2940 C Calculate the contribution to energy.
2941 ehpb=ehpb+waga*rdis*rdis
2943 C Evaluate gradient.
2946 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2947 cd & ' waga=',waga,' fac=',fac
2949 ggg(j)=fac*(c(j,jj)-c(j,ii))
2951 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2952 C If this is a SC-SC distance, we need to calculate the contributions to the
2953 C Cartesian gradient in the SC vectors (ghpbx).
2956 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2957 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2962 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2970 C--------------------------------------------------------------------------
2971 subroutine ssbond_ene(i,j,eij)
2973 C Calculate the distance and angle dependent SS-bond potential energy
2974 C using a free-energy function derived based on RHF/6-31G** ab initio
2975 C calculations of diethyl disulfide.
2977 C A. Liwo and U. Kozlowska, 11/24/03
2979 implicit real*8 (a-h,o-z)
2980 include 'DIMENSIONS'
2981 include 'DIMENSIONS.ZSCOPT'
2982 include 'COMMON.SBRIDGE'
2983 include 'COMMON.CHAIN'
2984 include 'COMMON.DERIV'
2985 include 'COMMON.LOCAL'
2986 include 'COMMON.INTERACT'
2987 include 'COMMON.VAR'
2988 include 'COMMON.IOUNITS'
2989 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2990 itypi=iabs(itype(i))
2994 dxi=dc_norm(1,nres+i)
2995 dyi=dc_norm(2,nres+i)
2996 dzi=dc_norm(3,nres+i)
2997 dsci_inv=dsc_inv(itypi)
2998 itypj=iabs(itype(j))
2999 dscj_inv=dsc_inv(itypj)
3003 dxj=dc_norm(1,nres+j)
3004 dyj=dc_norm(2,nres+j)
3005 dzj=dc_norm(3,nres+j)
3006 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3011 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3012 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3013 om12=dxi*dxj+dyi*dyj+dzi*dzj
3015 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3016 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3022 deltat12=om2-om1+2.0d0
3024 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3025 & +akct*deltad*deltat12
3026 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3027 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3028 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3029 c & " deltat12",deltat12," eij",eij
3030 ed=2*akcm*deltad+akct*deltat12
3032 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3033 eom1=-2*akth*deltat1-pom1-om2*pom2
3034 eom2= 2*akth*deltat2+pom1-om1*pom2
3037 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3040 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3041 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3042 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3043 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3046 C Calculate the components of the gradient in DC and X
3050 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3055 C--------------------------------------------------------------------------
3056 subroutine ebond(estr)
3058 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3060 implicit real*8 (a-h,o-z)
3061 include 'DIMENSIONS'
3062 include 'DIMENSIONS.ZSCOPT'
3063 include 'COMMON.LOCAL'
3064 include 'COMMON.GEO'
3065 include 'COMMON.INTERACT'
3066 include 'COMMON.DERIV'
3067 include 'COMMON.VAR'
3068 include 'COMMON.CHAIN'
3069 include 'COMMON.IOUNITS'
3070 include 'COMMON.NAMES'
3071 include 'COMMON.FFIELD'
3072 include 'COMMON.CONTROL'
3073 logical energy_dec /.false./
3074 double precision u(3),ud(3)
3077 c write (iout,*) "distchainmax",distchainmax
3079 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3080 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3082 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3083 & *dc(j,i-1)/vbld(i)
3085 if (energy_dec) write(iout,*)
3086 & "estr1",i,vbld(i),distchainmax,
3087 & gnmr1(vbld(i),-1.0d0,distchainmax)
3089 diff = vbld(i)-vbldp0
3090 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3093 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3098 estr=0.5d0*AKP*estr+estr1
3100 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3104 if (iti.ne.10 .and. iti.ne.ntyp1) then
3107 diff=vbld(i+nres)-vbldsc0(1,iti)
3108 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3109 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3110 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3112 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3116 diff=vbld(i+nres)-vbldsc0(j,iti)
3117 ud(j)=aksc(j,iti)*diff
3118 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3132 uprod2=uprod2*u(k)*u(k)
3136 usumsqder=usumsqder+ud(j)*uprod2
3138 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3139 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3140 estr=estr+uprod/usum
3142 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3150 C--------------------------------------------------------------------------
3151 subroutine ebend(etheta)
3153 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3154 C angles gamma and its derivatives in consecutive thetas and gammas.
3156 implicit real*8 (a-h,o-z)
3157 include 'DIMENSIONS'
3158 include 'DIMENSIONS.ZSCOPT'
3159 include 'COMMON.LOCAL'
3160 include 'COMMON.GEO'
3161 include 'COMMON.INTERACT'
3162 include 'COMMON.DERIV'
3163 include 'COMMON.VAR'
3164 include 'COMMON.CHAIN'
3165 include 'COMMON.IOUNITS'
3166 include 'COMMON.NAMES'
3167 include 'COMMON.FFIELD'
3168 common /calcthet/ term1,term2,termm,diffak,ratak,
3169 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3170 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3171 double precision y(2),z(2)
3173 time11=dexp(-2*time)
3176 c write (iout,*) "nres",nres
3177 c write (*,'(a,i2)') 'EBEND ICG=',icg
3178 c write (iout,*) ithet_start,ithet_end
3179 do i=ithet_start,ithet_end
3180 if (itype(i-1).eq.ntyp1) cycle
3181 C Zero the energy function and its derivative at 0 or pi.
3182 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3184 ichir1=isign(1,itype(i-2))
3185 ichir2=isign(1,itype(i))
3186 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3187 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3188 if (itype(i-1).eq.10) then
3189 itype1=isign(10,itype(i-2))
3190 ichir11=isign(1,itype(i-2))
3191 ichir12=isign(1,itype(i-2))
3192 itype2=isign(10,itype(i))
3193 ichir21=isign(1,itype(i))
3194 ichir22=isign(1,itype(i))
3197 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3201 call proc_proc(phii,icrc)
3202 if (icrc.eq.1) phii=150.0
3212 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3216 call proc_proc(phii1,icrc)
3217 if (icrc.eq.1) phii1=150.0
3229 C Calculate the "mean" value of theta from the part of the distribution
3230 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3231 C In following comments this theta will be referred to as t_c.
3232 thet_pred_mean=0.0d0
3234 athetk=athet(k,it,ichir1,ichir2)
3235 bthetk=bthet(k,it,ichir1,ichir2)
3237 athetk=athet(k,itype1,ichir11,ichir12)
3238 bthetk=bthet(k,itype2,ichir21,ichir22)
3240 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3242 c write (iout,*) "thet_pred_mean",thet_pred_mean
3243 dthett=thet_pred_mean*ssd
3244 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3245 c write (iout,*) "thet_pred_mean",thet_pred_mean
3246 C Derivatives of the "mean" values in gamma1 and gamma2.
3247 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3248 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3249 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3250 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3252 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3253 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3254 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3255 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3257 if (theta(i).gt.pi-delta) then
3258 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3260 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3261 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3262 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3264 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3266 else if (theta(i).lt.delta) then
3267 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3268 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3269 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3271 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3272 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3275 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3278 etheta=etheta+ethetai
3279 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3280 c & rad2deg*phii,rad2deg*phii1,ethetai
3281 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3282 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3283 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3286 C Ufff.... We've done all this!!!
3289 C---------------------------------------------------------------------------
3290 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3292 implicit real*8 (a-h,o-z)
3293 include 'DIMENSIONS'
3294 include 'COMMON.LOCAL'
3295 include 'COMMON.IOUNITS'
3296 common /calcthet/ term1,term2,termm,diffak,ratak,
3297 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3298 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3299 C Calculate the contributions to both Gaussian lobes.
3300 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3301 C The "polynomial part" of the "standard deviation" of this part of
3305 sig=sig*thet_pred_mean+polthet(j,it)
3307 C Derivative of the "interior part" of the "standard deviation of the"
3308 C gamma-dependent Gaussian lobe in t_c.
3309 sigtc=3*polthet(3,it)
3311 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3314 C Set the parameters of both Gaussian lobes of the distribution.
3315 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3316 fac=sig*sig+sigc0(it)
3319 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3320 sigsqtc=-4.0D0*sigcsq*sigtc
3321 c print *,i,sig,sigtc,sigsqtc
3322 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3323 sigtc=-sigtc/(fac*fac)
3324 C Following variable is sigma(t_c)**(-2)
3325 sigcsq=sigcsq*sigcsq
3327 sig0inv=1.0D0/sig0i**2
3328 delthec=thetai-thet_pred_mean
3329 delthe0=thetai-theta0i
3330 term1=-0.5D0*sigcsq*delthec*delthec
3331 term2=-0.5D0*sig0inv*delthe0*delthe0
3332 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3333 C NaNs in taking the logarithm. We extract the largest exponent which is added
3334 C to the energy (this being the log of the distribution) at the end of energy
3335 C term evaluation for this virtual-bond angle.
3336 if (term1.gt.term2) then
3338 term2=dexp(term2-termm)
3342 term1=dexp(term1-termm)
3345 C The ratio between the gamma-independent and gamma-dependent lobes of
3346 C the distribution is a Gaussian function of thet_pred_mean too.
3347 diffak=gthet(2,it)-thet_pred_mean
3348 ratak=diffak/gthet(3,it)**2
3349 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3350 C Let's differentiate it in thet_pred_mean NOW.
3352 C Now put together the distribution terms to make complete distribution.
3353 termexp=term1+ak*term2
3354 termpre=sigc+ak*sig0i
3355 C Contribution of the bending energy from this theta is just the -log of
3356 C the sum of the contributions from the two lobes and the pre-exponential
3357 C factor. Simple enough, isn't it?
3358 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3359 C NOW the derivatives!!!
3360 C 6/6/97 Take into account the deformation.
3361 E_theta=(delthec*sigcsq*term1
3362 & +ak*delthe0*sig0inv*term2)/termexp
3363 E_tc=((sigtc+aktc*sig0i)/termpre
3364 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3365 & aktc*term2)/termexp)
3368 c-----------------------------------------------------------------------------
3369 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3370 implicit real*8 (a-h,o-z)
3371 include 'DIMENSIONS'
3372 include 'COMMON.LOCAL'
3373 include 'COMMON.IOUNITS'
3374 common /calcthet/ term1,term2,termm,diffak,ratak,
3375 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3376 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3377 delthec=thetai-thet_pred_mean
3378 delthe0=thetai-theta0i
3379 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3380 t3 = thetai-thet_pred_mean
3384 t14 = t12+t6*sigsqtc
3386 t21 = thetai-theta0i
3392 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3393 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3394 & *(-t12*t9-ak*sig0inv*t27)
3398 C--------------------------------------------------------------------------
3399 subroutine ebend(etheta)
3401 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3402 C angles gamma and its derivatives in consecutive thetas and gammas.
3403 C ab initio-derived potentials from
3404 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3406 implicit real*8 (a-h,o-z)
3407 include 'DIMENSIONS'
3408 include 'DIMENSIONS.ZSCOPT'
3409 include 'COMMON.LOCAL'
3410 include 'COMMON.GEO'
3411 include 'COMMON.INTERACT'
3412 include 'COMMON.DERIV'
3413 include 'COMMON.VAR'
3414 include 'COMMON.CHAIN'
3415 include 'COMMON.IOUNITS'
3416 include 'COMMON.NAMES'
3417 include 'COMMON.FFIELD'
3418 include 'COMMON.CONTROL'
3419 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3420 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3421 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3422 & sinph1ph2(maxdouble,maxdouble)
3423 logical lprn /.false./, lprn1 /.false./
3425 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3426 do i=ithet_start,ithet_end
3427 if (itype(i-1).eq.ntyp1) cycle
3428 if (iabs(itype(i+1)).eq.20) iblock=2
3429 if (iabs(itype(i+1)).ne.20) iblock=1
3433 theti2=0.5d0*theta(i)
3434 ityp2=ithetyp((itype(i-1)))
3436 coskt(k)=dcos(k*theti2)
3437 sinkt(k)=dsin(k*theti2)
3439 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3442 if (phii.ne.phii) phii=150.0
3446 ityp1=ithetyp((itype(i-2)))
3448 cosph1(k)=dcos(k*phii)
3449 sinph1(k)=dsin(k*phii)
3459 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3462 if (phii1.ne.phii1) phii1=150.0
3467 ityp3=ithetyp((itype(i)))
3469 cosph2(k)=dcos(k*phii1)
3470 sinph2(k)=dsin(k*phii1)
3480 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3481 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3483 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3486 ccl=cosph1(l)*cosph2(k-l)
3487 ssl=sinph1(l)*sinph2(k-l)
3488 scl=sinph1(l)*cosph2(k-l)
3489 csl=cosph1(l)*sinph2(k-l)
3490 cosph1ph2(l,k)=ccl-ssl
3491 cosph1ph2(k,l)=ccl+ssl
3492 sinph1ph2(l,k)=scl+csl
3493 sinph1ph2(k,l)=scl-csl
3497 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3498 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3499 write (iout,*) "coskt and sinkt"
3501 write (iout,*) k,coskt(k),sinkt(k)
3505 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3506 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3509 & write (iout,*) "k",k,"
3510 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3511 & " ethetai",ethetai
3514 write (iout,*) "cosph and sinph"
3516 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3518 write (iout,*) "cosph1ph2 and sinph2ph2"
3521 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3522 & sinph1ph2(l,k),sinph1ph2(k,l)
3525 write(iout,*) "ethetai",ethetai
3529 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3530 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3531 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3532 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3533 ethetai=ethetai+sinkt(m)*aux
3534 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3535 dephii=dephii+k*sinkt(m)*(
3536 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3537 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3538 dephii1=dephii1+k*sinkt(m)*(
3539 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3540 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3542 & write (iout,*) "m",m," k",k," bbthet",
3543 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3544 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3545 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3546 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3550 & write(iout,*) "ethetai",ethetai
3554 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3555 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3556 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3557 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3558 ethetai=ethetai+sinkt(m)*aux
3559 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3560 dephii=dephii+l*sinkt(m)*(
3561 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3562 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3563 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3564 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3565 dephii1=dephii1+(k-l)*sinkt(m)*(
3566 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3567 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3568 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3569 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3571 write (iout,*) "m",m," k",k," l",l," ffthet",
3572 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3573 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3574 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3575 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3576 & " ethetai",ethetai
3577 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3578 & cosph1ph2(k,l)*sinkt(m),
3579 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3585 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3586 & i,theta(i)*rad2deg,phii*rad2deg,
3587 & phii1*rad2deg,ethetai
3588 etheta=etheta+ethetai
3589 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3590 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3591 gloc(nphi+i-2,icg)=wang*dethetai
3597 c-----------------------------------------------------------------------------
3598 subroutine esc(escloc)
3599 C Calculate the local energy of a side chain and its derivatives in the
3600 C corresponding virtual-bond valence angles THETA and the spherical angles
3602 implicit real*8 (a-h,o-z)
3603 include 'DIMENSIONS'
3604 include 'DIMENSIONS.ZSCOPT'
3605 include 'COMMON.GEO'
3606 include 'COMMON.LOCAL'
3607 include 'COMMON.VAR'
3608 include 'COMMON.INTERACT'
3609 include 'COMMON.DERIV'
3610 include 'COMMON.CHAIN'
3611 include 'COMMON.IOUNITS'
3612 include 'COMMON.NAMES'
3613 include 'COMMON.FFIELD'
3614 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3615 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3616 common /sccalc/ time11,time12,time112,theti,it,nlobit
3619 c write (iout,'(a)') 'ESC'
3620 do i=loc_start,loc_end
3622 if (it.eq.ntyp1) cycle
3623 if (it.eq.10) goto 1
3624 nlobit=nlob(iabs(it))
3625 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3626 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3627 theti=theta(i+1)-pipol
3631 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3633 if (x(2).gt.pi-delta) then
3637 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3639 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3640 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3642 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3643 & ddersc0(1),dersc(1))
3644 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3645 & ddersc0(3),dersc(3))
3647 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3649 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3650 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3651 & dersc0(2),esclocbi,dersc02)
3652 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3654 call splinthet(x(2),0.5d0*delta,ss,ssd)
3659 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3661 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3662 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3664 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3666 c write (iout,*) escloci
3667 else if (x(2).lt.delta) then
3671 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3673 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3674 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3676 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3677 & ddersc0(1),dersc(1))
3678 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3679 & ddersc0(3),dersc(3))
3681 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3683 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3684 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3685 & dersc0(2),esclocbi,dersc02)
3686 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3691 call splinthet(x(2),0.5d0*delta,ss,ssd)
3693 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3695 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3696 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3698 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3699 c write (iout,*) escloci
3701 call enesc(x,escloci,dersc,ddummy,.false.)
3704 escloc=escloc+escloci
3705 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3707 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3709 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3710 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3715 C---------------------------------------------------------------------------
3716 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3717 implicit real*8 (a-h,o-z)
3718 include 'DIMENSIONS'
3719 include 'COMMON.GEO'
3720 include 'COMMON.LOCAL'
3721 include 'COMMON.IOUNITS'
3722 common /sccalc/ time11,time12,time112,theti,it,nlobit
3723 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3724 double precision contr(maxlob,-1:1)
3726 c write (iout,*) 'it=',it,' nlobit=',nlobit
3730 if (mixed) ddersc(j)=0.0d0
3734 C Because of periodicity of the dependence of the SC energy in omega we have
3735 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3736 C To avoid underflows, first compute & store the exponents.
3744 z(k)=x(k)-censc(k,j,it)
3749 Axk=Axk+gaussc(l,k,j,it)*z(l)
3755 expfac=expfac+Ax(k,j,iii)*z(k)
3763 C As in the case of ebend, we want to avoid underflows in exponentiation and
3764 C subsequent NaNs and INFs in energy calculation.
3765 C Find the largest exponent
3769 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3773 cd print *,'it=',it,' emin=',emin
3775 C Compute the contribution to SC energy and derivatives
3779 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3780 cd print *,'j=',j,' expfac=',expfac
3781 escloc_i=escloc_i+expfac
3783 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3787 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3788 & +gaussc(k,2,j,it))*expfac
3795 dersc(1)=dersc(1)/cos(theti)**2
3796 ddersc(1)=ddersc(1)/cos(theti)**2
3799 escloci=-(dlog(escloc_i)-emin)
3801 dersc(j)=dersc(j)/escloc_i
3805 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3810 C------------------------------------------------------------------------------
3811 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3812 implicit real*8 (a-h,o-z)
3813 include 'DIMENSIONS'
3814 include 'COMMON.GEO'
3815 include 'COMMON.LOCAL'
3816 include 'COMMON.IOUNITS'
3817 common /sccalc/ time11,time12,time112,theti,it,nlobit
3818 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3819 double precision contr(maxlob)
3830 z(k)=x(k)-censc(k,j,it)
3836 Axk=Axk+gaussc(l,k,j,it)*z(l)
3842 expfac=expfac+Ax(k,j)*z(k)
3847 C As in the case of ebend, we want to avoid underflows in exponentiation and
3848 C subsequent NaNs and INFs in energy calculation.
3849 C Find the largest exponent
3852 if (emin.gt.contr(j)) emin=contr(j)
3856 C Compute the contribution to SC energy and derivatives
3860 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3861 escloc_i=escloc_i+expfac
3863 dersc(k)=dersc(k)+Ax(k,j)*expfac
3865 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3866 & +gaussc(1,2,j,it))*expfac
3870 dersc(1)=dersc(1)/cos(theti)**2
3871 dersc12=dersc12/cos(theti)**2
3872 escloci=-(dlog(escloc_i)-emin)
3874 dersc(j)=dersc(j)/escloc_i
3876 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3880 c----------------------------------------------------------------------------------
3881 subroutine esc(escloc)
3882 C Calculate the local energy of a side chain and its derivatives in the
3883 C corresponding virtual-bond valence angles THETA and the spherical angles
3884 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3885 C added by Urszula Kozlowska. 07/11/2007
3887 implicit real*8 (a-h,o-z)
3888 include 'DIMENSIONS'
3889 include 'DIMENSIONS.ZSCOPT'
3890 include 'COMMON.GEO'
3891 include 'COMMON.LOCAL'
3892 include 'COMMON.VAR'
3893 include 'COMMON.SCROT'
3894 include 'COMMON.INTERACT'
3895 include 'COMMON.DERIV'
3896 include 'COMMON.CHAIN'
3897 include 'COMMON.IOUNITS'
3898 include 'COMMON.NAMES'
3899 include 'COMMON.FFIELD'
3900 include 'COMMON.CONTROL'
3901 include 'COMMON.VECTORS'
3902 double precision x_prime(3),y_prime(3),z_prime(3)
3903 & , sumene,dsc_i,dp2_i,x(65),
3904 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3905 & de_dxx,de_dyy,de_dzz,de_dt
3906 double precision s1_t,s1_6_t,s2_t,s2_6_t
3908 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3909 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3910 & dt_dCi(3),dt_dCi1(3)
3911 common /sccalc/ time11,time12,time112,theti,it,nlobit
3914 do i=loc_start,loc_end
3915 if (itype(i).eq.ntyp1) cycle
3916 costtab(i+1) =dcos(theta(i+1))
3917 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3918 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3919 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3920 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3921 cosfac=dsqrt(cosfac2)
3922 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3923 sinfac=dsqrt(sinfac2)
3925 if (it.eq.10) goto 1
3927 C Compute the axes of tghe local cartesian coordinates system; store in
3928 c x_prime, y_prime and z_prime
3935 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3936 C & dc_norm(3,i+nres)
3938 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3939 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3942 z_prime(j) = -uz(j,i-1)*dsign(1.0,dfloat(itype(i)))
3945 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3946 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3947 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3948 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3949 c & " xy",scalar(x_prime(1),y_prime(1)),
3950 c & " xz",scalar(x_prime(1),z_prime(1)),
3951 c & " yy",scalar(y_prime(1),y_prime(1)),
3952 c & " yz",scalar(y_prime(1),z_prime(1)),
3953 c & " zz",scalar(z_prime(1),z_prime(1))
3955 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3956 C to local coordinate system. Store in xx, yy, zz.
3962 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3963 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3964 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3971 C Compute the energy of the ith side cbain
3973 c write (2,*) "xx",xx," yy",yy," zz",zz
3976 x(j) = sc_parmin(j,it)
3979 Cc diagnostics - remove later
3981 yy1 = dsin(alph(2))*dcos(omeg(2))
3982 zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
3983 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3984 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3986 C," --- ", xx_w,yy_w,zz_w
3989 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3990 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3992 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3993 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3995 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3996 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3997 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3998 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3999 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4001 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4002 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4003 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4004 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4005 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4007 dsc_i = 0.743d0+x(61)
4009 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4010 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4011 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4012 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4013 s1=(1+x(63))/(0.1d0 + dscp1)
4014 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4015 s2=(1+x(65))/(0.1d0 + dscp2)
4016 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4017 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4018 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4019 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4021 c & dscp1,dscp2,sumene
4022 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4023 escloc = escloc + sumene
4024 c write (2,*) "escloc",escloc
4025 if (.not. calc_grad) goto 1
4028 C This section to check the numerical derivatives of the energy of ith side
4029 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4030 C #define DEBUG in the code to turn it on.
4032 write (2,*) "sumene =",sumene
4036 write (2,*) xx,yy,zz
4037 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4038 de_dxx_num=(sumenep-sumene)/aincr
4040 write (2,*) "xx+ sumene from enesc=",sumenep
4043 write (2,*) xx,yy,zz
4044 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4045 de_dyy_num=(sumenep-sumene)/aincr
4047 write (2,*) "yy+ sumene from enesc=",sumenep
4050 write (2,*) xx,yy,zz
4051 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4052 de_dzz_num=(sumenep-sumene)/aincr
4054 write (2,*) "zz+ sumene from enesc=",sumenep
4055 costsave=cost2tab(i+1)
4056 sintsave=sint2tab(i+1)
4057 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4058 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4059 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4060 de_dt_num=(sumenep-sumene)/aincr
4061 write (2,*) " t+ sumene from enesc=",sumenep
4062 cost2tab(i+1)=costsave
4063 sint2tab(i+1)=sintsave
4064 C End of diagnostics section.
4067 C Compute the gradient of esc
4069 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4070 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4071 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4072 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4073 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4074 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4075 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4076 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4077 pom1=(sumene3*sint2tab(i+1)+sumene1)
4078 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4079 pom2=(sumene4*cost2tab(i+1)+sumene2)
4080 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4081 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4082 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4083 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4085 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4086 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4087 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4089 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4090 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4091 & +(pom1+pom2)*pom_dx
4093 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4096 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4097 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4098 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4100 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4101 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4102 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4103 & +x(59)*zz**2 +x(60)*xx*zz
4104 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4105 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4106 & +(pom1-pom2)*pom_dy
4108 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4111 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4112 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4113 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4114 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4115 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4116 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4117 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4118 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4120 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4123 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4124 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4125 & +pom1*pom_dt1+pom2*pom_dt2
4127 write(2,*), "de_dt = ", de_dt,de_dt_num
4131 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4132 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4133 cosfac2xx=cosfac2*xx
4134 sinfac2yy=sinfac2*yy
4136 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4138 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4140 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4141 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4142 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4143 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4144 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4145 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4146 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4147 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4148 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4149 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4153 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4154 & *dsign(1.0,dfloat(itype(i)))*dC_norm(j,i+nres)
4155 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4156 & *dsign(1.0,dfloat(itype(i)))*dC_norm(j,i+nres)
4159 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4160 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4161 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4163 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4164 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4168 dXX_Ctab(k,i)=dXX_Ci(k)
4169 dXX_C1tab(k,i)=dXX_Ci1(k)
4170 dYY_Ctab(k,i)=dYY_Ci(k)
4171 dYY_C1tab(k,i)=dYY_Ci1(k)
4172 dZZ_Ctab(k,i)=dZZ_Ci(k)
4173 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4174 dXX_XYZtab(k,i)=dXX_XYZ(k)
4175 dYY_XYZtab(k,i)=dYY_XYZ(k)
4176 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4180 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4181 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4182 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4183 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4184 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4186 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4187 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4188 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4189 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4190 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4191 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4192 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4193 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4195 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4196 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4198 C to check gradient call subroutine check_grad
4205 c------------------------------------------------------------------------------
4206 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4208 C This procedure calculates two-body contact function g(rij) and its derivative:
4211 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4214 C where x=(rij-r0ij)/delta
4216 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4219 double precision rij,r0ij,eps0ij,fcont,fprimcont
4220 double precision x,x2,x4,delta
4224 if (x.lt.-1.0D0) then
4227 else if (x.le.1.0D0) then
4230 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4231 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4238 c------------------------------------------------------------------------------
4239 subroutine splinthet(theti,delta,ss,ssder)
4240 implicit real*8 (a-h,o-z)
4241 include 'DIMENSIONS'
4242 include 'DIMENSIONS.ZSCOPT'
4243 include 'COMMON.VAR'
4244 include 'COMMON.GEO'
4247 if (theti.gt.pipol) then
4248 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4250 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4255 c------------------------------------------------------------------------------
4256 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4258 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4259 double precision ksi,ksi2,ksi3,a1,a2,a3
4260 a1=fprim0*delta/(f1-f0)
4266 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4267 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4270 c------------------------------------------------------------------------------
4271 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4273 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4274 double precision ksi,ksi2,ksi3,a1,a2,a3
4279 a2=3*(f1x-f0x)-2*fprim0x*delta
4280 a3=fprim0x*delta-2*(f1x-f0x)
4281 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4284 C-----------------------------------------------------------------------------
4286 C-----------------------------------------------------------------------------
4287 subroutine etor(etors,edihcnstr,fact)
4288 implicit real*8 (a-h,o-z)
4289 include 'DIMENSIONS'
4290 include 'DIMENSIONS.ZSCOPT'
4291 include 'COMMON.VAR'
4292 include 'COMMON.GEO'
4293 include 'COMMON.LOCAL'
4294 include 'COMMON.TORSION'
4295 include 'COMMON.INTERACT'
4296 include 'COMMON.DERIV'
4297 include 'COMMON.CHAIN'
4298 include 'COMMON.NAMES'
4299 include 'COMMON.IOUNITS'
4300 include 'COMMON.FFIELD'
4301 include 'COMMON.TORCNSTR'
4303 C Set lprn=.true. for debugging
4307 do i=iphi_start,iphi_end
4308 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4309 & .or. itype(i).eq.ntyp1) cycle
4310 itori=itortyp(itype(i-2))
4311 itori1=itortyp(itype(i-1))
4314 C Proline-Proline pair is a special case...
4315 if (itori.eq.3 .and. itori1.eq.3) then
4316 if (phii.gt.-dwapi3) then
4318 fac=1.0D0/(1.0D0-cosphi)
4319 etorsi=v1(1,3,3)*fac
4320 etorsi=etorsi+etorsi
4321 etors=etors+etorsi-v1(1,3,3)
4322 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4325 v1ij=v1(j+1,itori,itori1)
4326 v2ij=v2(j+1,itori,itori1)
4329 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4330 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4334 v1ij=v1(j,itori,itori1)
4335 v2ij=v2(j,itori,itori1)
4338 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4339 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4343 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4344 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4345 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4346 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4347 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4349 ! 6/20/98 - dihedral angle constraints
4352 itori=idih_constr(i)
4355 if (difi.gt.drange(i)) then
4357 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4358 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4359 else if (difi.lt.-drange(i)) then
4361 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4362 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4364 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4365 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4367 ! write (iout,*) 'edihcnstr',edihcnstr
4370 c------------------------------------------------------------------------------
4372 subroutine etor(etors,edihcnstr,fact)
4373 implicit real*8 (a-h,o-z)
4374 include 'DIMENSIONS'
4375 include 'DIMENSIONS.ZSCOPT'
4376 include 'COMMON.VAR'
4377 include 'COMMON.GEO'
4378 include 'COMMON.LOCAL'
4379 include 'COMMON.TORSION'
4380 include 'COMMON.INTERACT'
4381 include 'COMMON.DERIV'
4382 include 'COMMON.CHAIN'
4383 include 'COMMON.NAMES'
4384 include 'COMMON.IOUNITS'
4385 include 'COMMON.FFIELD'
4386 include 'COMMON.TORCNSTR'
4388 C Set lprn=.true. for debugging
4392 do i=iphi_start,iphi_end
4393 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4394 & .or. itype(i).eq.ntyp1) cycle
4395 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4396 if (iabs(itype(i)).eq.20) then
4401 itori=itortyp(itype(i-2))
4402 itori1=itortyp(itype(i-1))
4405 C Regular cosine and sine terms
4406 do j=1,nterm(itori,itori1,iblock)
4407 v1ij=v1(j,itori,itori1,iblock)
4408 v2ij=v2(j,itori,itori1,iblock)
4411 etors=etors+v1ij*cosphi+v2ij*sinphi
4412 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4416 C E = SUM ----------------------------------- - v1
4417 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4419 cosphi=dcos(0.5d0*phii)
4420 sinphi=dsin(0.5d0*phii)
4421 do j=1,nlor(itori,itori1,iblock)
4422 vl1ij=vlor1(j,itori,itori1)
4423 vl2ij=vlor2(j,itori,itori1)
4424 vl3ij=vlor3(j,itori,itori1)
4425 pom=vl2ij*cosphi+vl3ij*sinphi
4426 pom1=1.0d0/(pom*pom+1.0d0)
4427 etors=etors+vl1ij*pom1
4428 c if (energy_dec) etors_ii=etors_ii+
4431 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4433 C Subtract the constant term
4434 etors=etors-v0(itori,itori1,iblock)
4436 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4437 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4438 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4439 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4440 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4443 ! 6/20/98 - dihedral angle constraints
4446 itori=idih_constr(i)
4448 difi=pinorm(phii-phi0(i))
4450 if (difi.gt.drange(i)) then
4452 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4453 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4454 edihi=0.25d0*ftors*difi**4
4455 else if (difi.lt.-drange(i)) then
4457 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4458 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4459 edihi=0.25d0*ftors*difi**4
4463 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4465 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4466 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4468 ! write (iout,*) 'edihcnstr',edihcnstr
4471 c----------------------------------------------------------------------------
4472 subroutine etor_d(etors_d,fact2)
4473 C 6/23/01 Compute double torsional energy
4474 implicit real*8 (a-h,o-z)
4475 include 'DIMENSIONS'
4476 include 'DIMENSIONS.ZSCOPT'
4477 include 'COMMON.VAR'
4478 include 'COMMON.GEO'
4479 include 'COMMON.LOCAL'
4480 include 'COMMON.TORSION'
4481 include 'COMMON.INTERACT'
4482 include 'COMMON.DERIV'
4483 include 'COMMON.CHAIN'
4484 include 'COMMON.NAMES'
4485 include 'COMMON.IOUNITS'
4486 include 'COMMON.FFIELD'
4487 include 'COMMON.TORCNSTR'
4489 C Set lprn=.true. for debugging
4493 do i=iphi_start,iphi_end-1
4494 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4495 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4496 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4498 itori=itortyp(itype(i-2))
4499 itori1=itortyp(itype(i-1))
4500 itori2=itortyp(itype(i))
4506 if (iabs(itype(i+1)).eq.20) iblock=2
4507 C Regular cosine and sine terms
4508 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4509 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4510 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4511 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4512 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4513 cosphi1=dcos(j*phii)
4514 sinphi1=dsin(j*phii)
4515 cosphi2=dcos(j*phii1)
4516 sinphi2=dsin(j*phii1)
4517 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4518 & v2cij*cosphi2+v2sij*sinphi2
4519 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4520 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4522 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4524 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4525 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4526 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4527 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4528 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4529 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4530 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4531 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4532 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4533 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4534 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4535 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4536 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4537 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4540 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4541 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4547 c------------------------------------------------------------------------------
4548 subroutine eback_sc_corr(esccor)
4549 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4550 c conformational states; temporarily implemented as differences
4551 c between UNRES torsional potentials (dependent on three types of
4552 c residues) and the torsional potentials dependent on all 20 types
4553 c of residues computed from AM1 energy surfaces of terminally-blocked
4554 c amino-acid residues.
4555 implicit real*8 (a-h,o-z)
4556 include 'DIMENSIONS'
4557 include 'DIMENSIONS.ZSCOPT'
4558 include 'COMMON.VAR'
4559 include 'COMMON.GEO'
4560 include 'COMMON.LOCAL'
4561 include 'COMMON.TORSION'
4562 include 'COMMON.SCCOR'
4563 include 'COMMON.INTERACT'
4564 include 'COMMON.DERIV'
4565 include 'COMMON.CHAIN'
4566 include 'COMMON.NAMES'
4567 include 'COMMON.IOUNITS'
4568 include 'COMMON.FFIELD'
4569 include 'COMMON.CONTROL'
4571 C Set lprn=.true. for debugging
4574 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4576 do i=itau_start,itau_end
4577 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4579 isccori=isccortyp(itype(i-2))
4580 isccori1=isccortyp(itype(i-1))
4582 do intertyp=1,3 !intertyp
4583 cc Added 09 May 2012 (Adasko)
4584 cc Intertyp means interaction type of backbone mainchain correlation:
4585 c 1 = SC...Ca...Ca...Ca
4586 c 2 = Ca...Ca...Ca...SC
4587 c 3 = SC...Ca...Ca...SCi
4589 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4590 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4591 & (itype(i-1).eq.ntyp1)))
4592 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4593 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4594 & .or.(itype(i).eq.ntyp1)))
4595 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4596 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4597 & (itype(i-3).eq.ntyp1)))) cycle
4598 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4599 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4601 do j=1,nterm_sccor(isccori,isccori1)
4602 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4603 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4604 cosphi=dcos(j*tauangle(intertyp,i))
4605 sinphi=dsin(j*tauangle(intertyp,i))
4606 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4607 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4609 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4610 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4611 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4613 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4614 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4615 & (v1sccor(j,1,itori,itori1),j=1,6)
4616 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4617 c gsccor_loc(i-3)=gloci
4622 c------------------------------------------------------------------------------
4623 subroutine multibody(ecorr)
4624 C This subroutine calculates multi-body contributions to energy following
4625 C the idea of Skolnick et al. If side chains I and J make a contact and
4626 C at the same time side chains I+1 and J+1 make a contact, an extra
4627 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4628 implicit real*8 (a-h,o-z)
4629 include 'DIMENSIONS'
4630 include 'COMMON.IOUNITS'
4631 include 'COMMON.DERIV'
4632 include 'COMMON.INTERACT'
4633 include 'COMMON.CONTACTS'
4634 double precision gx(3),gx1(3)
4637 C Set lprn=.true. for debugging
4641 write (iout,'(a)') 'Contact function values:'
4643 write (iout,'(i2,20(1x,i2,f10.5))')
4644 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4659 num_conti=num_cont(i)
4660 num_conti1=num_cont(i1)
4665 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4666 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4667 cd & ' ishift=',ishift
4668 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4669 C The system gains extra energy.
4670 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4671 endif ! j1==j+-ishift
4680 c------------------------------------------------------------------------------
4681 double precision function esccorr(i,j,k,l,jj,kk)
4682 implicit real*8 (a-h,o-z)
4683 include 'DIMENSIONS'
4684 include 'COMMON.IOUNITS'
4685 include 'COMMON.DERIV'
4686 include 'COMMON.INTERACT'
4687 include 'COMMON.CONTACTS'
4688 double precision gx(3),gx1(3)
4693 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4694 C Calculate the multi-body contribution to energy.
4695 C Calculate multi-body contributions to the gradient.
4696 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4697 cd & k,l,(gacont(m,kk,k),m=1,3)
4699 gx(m) =ekl*gacont(m,jj,i)
4700 gx1(m)=eij*gacont(m,kk,k)
4701 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4702 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4703 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4704 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4708 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4713 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4719 c------------------------------------------------------------------------------
4721 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4722 implicit real*8 (a-h,o-z)
4723 include 'DIMENSIONS'
4724 integer dimen1,dimen2,atom,indx
4725 double precision buffer(dimen1,dimen2)
4726 double precision zapas
4727 common /contacts_hb/ zapas(3,20,maxres,7),
4728 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4729 & num_cont_hb(maxres),jcont_hb(20,maxres)
4730 num_kont=num_cont_hb(atom)
4734 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4737 buffer(i,indx+22)=facont_hb(i,atom)
4738 buffer(i,indx+23)=ees0p(i,atom)
4739 buffer(i,indx+24)=ees0m(i,atom)
4740 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4742 buffer(1,indx+26)=dfloat(num_kont)
4745 c------------------------------------------------------------------------------
4746 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4747 implicit real*8 (a-h,o-z)
4748 include 'DIMENSIONS'
4749 integer dimen1,dimen2,atom,indx
4750 double precision buffer(dimen1,dimen2)
4751 double precision zapas
4752 common /contacts_hb/ zapas(3,20,maxres,7),
4753 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4754 & num_cont_hb(maxres),jcont_hb(20,maxres)
4755 num_kont=buffer(1,indx+26)
4756 num_kont_old=num_cont_hb(atom)
4757 num_cont_hb(atom)=num_kont+num_kont_old
4762 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4765 facont_hb(ii,atom)=buffer(i,indx+22)
4766 ees0p(ii,atom)=buffer(i,indx+23)
4767 ees0m(ii,atom)=buffer(i,indx+24)
4768 jcont_hb(ii,atom)=buffer(i,indx+25)
4772 c------------------------------------------------------------------------------
4774 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4775 C This subroutine calculates multi-body contributions to hydrogen-bonding
4776 implicit real*8 (a-h,o-z)
4777 include 'DIMENSIONS'
4778 include 'DIMENSIONS.ZSCOPT'
4779 include 'COMMON.IOUNITS'
4781 include 'COMMON.INFO'
4783 include 'COMMON.FFIELD'
4784 include 'COMMON.DERIV'
4785 include 'COMMON.INTERACT'
4786 include 'COMMON.CONTACTS'
4788 parameter (max_cont=maxconts)
4789 parameter (max_dim=2*(8*3+2))
4790 parameter (msglen1=max_cont*max_dim*4)
4791 parameter (msglen2=2*msglen1)
4792 integer source,CorrelType,CorrelID,Error
4793 double precision buffer(max_cont,max_dim)
4795 double precision gx(3),gx1(3)
4798 C Set lprn=.true. for debugging
4803 if (fgProcs.le.1) goto 30
4805 write (iout,'(a)') 'Contact function values:'
4807 write (iout,'(2i3,50(1x,i2,f5.2))')
4808 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4809 & j=1,num_cont_hb(i))
4812 C Caution! Following code assumes that electrostatic interactions concerning
4813 C a given atom are split among at most two processors!
4823 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4826 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4827 if (MyRank.gt.0) then
4828 C Send correlation contributions to the preceding processor
4830 nn=num_cont_hb(iatel_s)
4831 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4832 cd write (iout,*) 'The BUFFER array:'
4834 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4836 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4838 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4839 C Clear the contacts of the atom passed to the neighboring processor
4840 nn=num_cont_hb(iatel_s+1)
4842 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4844 num_cont_hb(iatel_s)=0
4846 cd write (iout,*) 'Processor ',MyID,MyRank,
4847 cd & ' is sending correlation contribution to processor',MyID-1,
4848 cd & ' msglen=',msglen
4849 cd write (*,*) 'Processor ',MyID,MyRank,
4850 cd & ' is sending correlation contribution to processor',MyID-1,
4851 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4852 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4853 cd write (iout,*) 'Processor ',MyID,
4854 cd & ' has sent correlation contribution to processor',MyID-1,
4855 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4856 cd write (*,*) 'Processor ',MyID,
4857 cd & ' has sent correlation contribution to processor',MyID-1,
4858 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4860 endif ! (MyRank.gt.0)
4864 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4865 if (MyRank.lt.fgProcs-1) then
4866 C Receive correlation contributions from the next processor
4868 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4869 cd write (iout,*) 'Processor',MyID,
4870 cd & ' is receiving correlation contribution from processor',MyID+1,
4871 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4872 cd write (*,*) 'Processor',MyID,
4873 cd & ' is receiving correlation contribution from processor',MyID+1,
4874 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4876 do while (nbytes.le.0)
4877 call mp_probe(MyID+1,CorrelType,nbytes)
4879 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4880 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4881 cd write (iout,*) 'Processor',MyID,
4882 cd & ' has received correlation contribution from processor',MyID+1,
4883 cd & ' msglen=',msglen,' nbytes=',nbytes
4884 cd write (iout,*) 'The received BUFFER array:'
4886 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4888 if (msglen.eq.msglen1) then
4889 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4890 else if (msglen.eq.msglen2) then
4891 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4892 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4895 & 'ERROR!!!! message length changed while processing correlations.'
4897 & 'ERROR!!!! message length changed while processing correlations.'
4898 call mp_stopall(Error)
4899 endif ! msglen.eq.msglen1
4900 endif ! MyRank.lt.fgProcs-1
4907 write (iout,'(a)') 'Contact function values:'
4909 write (iout,'(2i3,50(1x,i2,f5.2))')
4910 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4911 & j=1,num_cont_hb(i))
4915 C Remove the loop below after debugging !!!
4922 C Calculate the local-electrostatic correlation terms
4923 do i=iatel_s,iatel_e+1
4925 num_conti=num_cont_hb(i)
4926 num_conti1=num_cont_hb(i+1)
4931 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4932 c & ' jj=',jj,' kk=',kk
4933 if (j1.eq.j+1 .or. j1.eq.j-1) then
4934 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4935 C The system gains extra energy.
4936 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4938 else if (j1.eq.j) then
4939 C Contacts I-J and I-(J+1) occur simultaneously.
4940 C The system loses extra energy.
4941 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4946 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4947 c & ' jj=',jj,' kk=',kk
4949 C Contacts I-J and (I+1)-J occur simultaneously.
4950 C The system loses extra energy.
4951 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4958 c------------------------------------------------------------------------------
4959 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4961 C This subroutine calculates multi-body contributions to hydrogen-bonding
4962 implicit real*8 (a-h,o-z)
4963 include 'DIMENSIONS'
4964 include 'DIMENSIONS.ZSCOPT'
4965 include 'COMMON.IOUNITS'
4967 include 'COMMON.INFO'
4969 include 'COMMON.FFIELD'
4970 include 'COMMON.DERIV'
4971 include 'COMMON.INTERACT'
4972 include 'COMMON.CONTACTS'
4974 parameter (max_cont=maxconts)
4975 parameter (max_dim=2*(8*3+2))
4976 parameter (msglen1=max_cont*max_dim*4)
4977 parameter (msglen2=2*msglen1)
4978 integer source,CorrelType,CorrelID,Error
4979 double precision buffer(max_cont,max_dim)
4981 double precision gx(3),gx1(3)
4984 C Set lprn=.true. for debugging
4990 if (fgProcs.le.1) goto 30
4992 write (iout,'(a)') 'Contact function values:'
4994 write (iout,'(2i3,50(1x,i2,f5.2))')
4995 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4996 & j=1,num_cont_hb(i))
4999 C Caution! Following code assumes that electrostatic interactions concerning
5000 C a given atom are split among at most two processors!
5010 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5013 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5014 if (MyRank.gt.0) then
5015 C Send correlation contributions to the preceding processor
5017 nn=num_cont_hb(iatel_s)
5018 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5019 cd write (iout,*) 'The BUFFER array:'
5021 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5023 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5025 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5026 C Clear the contacts of the atom passed to the neighboring processor
5027 nn=num_cont_hb(iatel_s+1)
5029 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5031 num_cont_hb(iatel_s)=0
5033 cd write (iout,*) 'Processor ',MyID,MyRank,
5034 cd & ' is sending correlation contribution to processor',MyID-1,
5035 cd & ' msglen=',msglen
5036 cd write (*,*) 'Processor ',MyID,MyRank,
5037 cd & ' is sending correlation contribution to processor',MyID-1,
5038 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5039 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5040 cd write (iout,*) 'Processor ',MyID,
5041 cd & ' has sent correlation contribution to processor',MyID-1,
5042 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5043 cd write (*,*) 'Processor ',MyID,
5044 cd & ' has sent correlation contribution to processor',MyID-1,
5045 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5047 endif ! (MyRank.gt.0)
5051 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5052 if (MyRank.lt.fgProcs-1) then
5053 C Receive correlation contributions from the next processor
5055 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5056 cd write (iout,*) 'Processor',MyID,
5057 cd & ' is receiving correlation contribution from processor',MyID+1,
5058 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5059 cd write (*,*) 'Processor',MyID,
5060 cd & ' is receiving correlation contribution from processor',MyID+1,
5061 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5063 do while (nbytes.le.0)
5064 call mp_probe(MyID+1,CorrelType,nbytes)
5066 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5067 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5068 cd write (iout,*) 'Processor',MyID,
5069 cd & ' has received correlation contribution from processor',MyID+1,
5070 cd & ' msglen=',msglen,' nbytes=',nbytes
5071 cd write (iout,*) 'The received BUFFER array:'
5073 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5075 if (msglen.eq.msglen1) then
5076 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5077 else if (msglen.eq.msglen2) then
5078 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5079 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5082 & 'ERROR!!!! message length changed while processing correlations.'
5084 & 'ERROR!!!! message length changed while processing correlations.'
5085 call mp_stopall(Error)
5086 endif ! msglen.eq.msglen1
5087 endif ! MyRank.lt.fgProcs-1
5094 write (iout,'(a)') 'Contact function values:'
5096 write (iout,'(2i3,50(1x,i2,f5.2))')
5097 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5098 & j=1,num_cont_hb(i))
5104 C Remove the loop below after debugging !!!
5111 C Calculate the dipole-dipole interaction energies
5112 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5113 do i=iatel_s,iatel_e+1
5114 num_conti=num_cont_hb(i)
5121 C Calculate the local-electrostatic correlation terms
5122 do i=iatel_s,iatel_e+1
5124 num_conti=num_cont_hb(i)
5125 num_conti1=num_cont_hb(i+1)
5130 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5131 c & ' jj=',jj,' kk=',kk
5132 if (j1.eq.j+1 .or. j1.eq.j-1) then
5133 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5134 C The system gains extra energy.
5136 sqd1=dsqrt(d_cont(jj,i))
5137 sqd2=dsqrt(d_cont(kk,i1))
5138 sred_geom = sqd1*sqd2
5139 IF (sred_geom.lt.cutoff_corr) THEN
5140 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5142 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5143 c & ' jj=',jj,' kk=',kk
5144 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5145 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5147 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5148 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5151 cd write (iout,*) 'sred_geom=',sred_geom,
5152 cd & ' ekont=',ekont,' fprim=',fprimcont
5153 call calc_eello(i,j,i+1,j1,jj,kk)
5154 if (wcorr4.gt.0.0d0)
5155 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5156 if (wcorr5.gt.0.0d0)
5157 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5158 c print *,"wcorr5",ecorr5
5159 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5160 cd write(2,*)'ijkl',i,j,i+1,j1
5161 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5162 & .or. wturn6.eq.0.0d0))then
5163 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5164 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5165 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5166 cd & 'ecorr6=',ecorr6
5167 cd write (iout,'(4e15.5)') sred_geom,
5168 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5169 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5170 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5171 else if (wturn6.gt.0.0d0
5172 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5173 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5174 eturn6=eturn6+eello_turn6(i,jj,kk)
5175 cd write (2,*) 'multibody_eello:eturn6',eturn6
5179 else if (j1.eq.j) then
5180 C Contacts I-J and I-(J+1) occur simultaneously.
5181 C The system loses extra energy.
5182 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5187 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5188 c & ' jj=',jj,' kk=',kk
5190 C Contacts I-J and (I+1)-J occur simultaneously.
5191 C The system loses extra energy.
5192 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5199 c------------------------------------------------------------------------------
5200 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5201 implicit real*8 (a-h,o-z)
5202 include 'DIMENSIONS'
5203 include 'COMMON.IOUNITS'
5204 include 'COMMON.DERIV'
5205 include 'COMMON.INTERACT'
5206 include 'COMMON.CONTACTS'
5207 double precision gx(3),gx1(3)
5217 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5218 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5219 C Following 4 lines for diagnostics.
5224 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5226 c write (iout,*)'Contacts have occurred for peptide groups',
5227 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5228 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5229 C Calculate the multi-body contribution to energy.
5230 ecorr=ecorr+ekont*ees
5232 C Calculate multi-body contributions to the gradient.
5234 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5235 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5236 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5237 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5238 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5239 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5240 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5241 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5242 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5243 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5244 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5245 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5246 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5247 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5251 gradcorr(ll,m)=gradcorr(ll,m)+
5252 & ees*ekl*gacont_hbr(ll,jj,i)-
5253 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5254 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5259 gradcorr(ll,m)=gradcorr(ll,m)+
5260 & ees*eij*gacont_hbr(ll,kk,k)-
5261 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5262 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5269 C---------------------------------------------------------------------------
5270 subroutine dipole(i,j,jj)
5271 implicit real*8 (a-h,o-z)
5272 include 'DIMENSIONS'
5273 include 'DIMENSIONS.ZSCOPT'
5274 include 'COMMON.IOUNITS'
5275 include 'COMMON.CHAIN'
5276 include 'COMMON.FFIELD'
5277 include 'COMMON.DERIV'
5278 include 'COMMON.INTERACT'
5279 include 'COMMON.CONTACTS'
5280 include 'COMMON.TORSION'
5281 include 'COMMON.VAR'
5282 include 'COMMON.GEO'
5283 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5285 iti1 = itortyp(itype(i+1))
5286 if (j.lt.nres-1) then
5287 if (itype(j).le.ntyp) then
5288 itj1 = itortyp(itype(j+1))
5296 dipi(iii,1)=Ub2(iii,i)
5297 dipderi(iii)=Ub2der(iii,i)
5298 dipi(iii,2)=b1(iii,iti1)
5299 dipj(iii,1)=Ub2(iii,j)
5300 dipderj(iii)=Ub2der(iii,j)
5301 dipj(iii,2)=b1(iii,itj1)
5305 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5308 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5311 if (.not.calc_grad) return
5316 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5320 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5325 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5326 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5328 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5330 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5332 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5336 C---------------------------------------------------------------------------
5337 subroutine calc_eello(i,j,k,l,jj,kk)
5339 C This subroutine computes matrices and vectors needed to calculate
5340 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5342 implicit real*8 (a-h,o-z)
5343 include 'DIMENSIONS'
5344 include 'DIMENSIONS.ZSCOPT'
5345 include 'COMMON.IOUNITS'
5346 include 'COMMON.CHAIN'
5347 include 'COMMON.DERIV'
5348 include 'COMMON.INTERACT'
5349 include 'COMMON.CONTACTS'
5350 include 'COMMON.TORSION'
5351 include 'COMMON.VAR'
5352 include 'COMMON.GEO'
5353 include 'COMMON.FFIELD'
5354 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5355 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5358 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5359 cd & ' jj=',jj,' kk=',kk
5360 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5363 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5364 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5367 call transpose2(aa1(1,1),aa1t(1,1))
5368 call transpose2(aa2(1,1),aa2t(1,1))
5371 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5372 & aa1tder(1,1,lll,kkk))
5373 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5374 & aa2tder(1,1,lll,kkk))
5378 C parallel orientation of the two CA-CA-CA frames.
5379 if (i.gt.1 .and. itype(i).le.ntyp) then
5380 iti=itortyp(itype(i))
5384 itk1=itortyp(itype(k+1))
5385 itj=itortyp(itype(j))
5386 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5387 itl1=itortyp(itype(l+1))
5391 C A1 kernel(j+1) A2T
5393 cd write (iout,'(3f10.5,5x,3f10.5)')
5394 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5396 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5397 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5398 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5399 C Following matrices are needed only for 6-th order cumulants
5400 IF (wcorr6.gt.0.0d0) THEN
5401 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5402 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5403 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5404 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5405 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5406 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5407 & ADtEAderx(1,1,1,1,1,1))
5409 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5410 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5411 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5412 & ADtEA1derx(1,1,1,1,1,1))
5414 C End 6-th order cumulants
5417 cd write (2,*) 'In calc_eello6'
5419 cd write (2,*) 'iii=',iii
5421 cd write (2,*) 'kkk=',kkk
5423 cd write (2,'(3(2f10.5),5x)')
5424 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5429 call transpose2(EUgder(1,1,k),auxmat(1,1))
5430 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5431 call transpose2(EUg(1,1,k),auxmat(1,1))
5432 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5433 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5437 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5438 & EAEAderx(1,1,lll,kkk,iii,1))
5442 C A1T kernel(i+1) A2
5443 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5444 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5445 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5446 C Following matrices are needed only for 6-th order cumulants
5447 IF (wcorr6.gt.0.0d0) THEN
5448 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5449 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5450 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5451 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5452 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5453 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5454 & ADtEAderx(1,1,1,1,1,2))
5455 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5456 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5457 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5458 & ADtEA1derx(1,1,1,1,1,2))
5460 C End 6-th order cumulants
5461 call transpose2(EUgder(1,1,l),auxmat(1,1))
5462 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5463 call transpose2(EUg(1,1,l),auxmat(1,1))
5464 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5465 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5469 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5470 & EAEAderx(1,1,lll,kkk,iii,2))
5475 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5476 C They are needed only when the fifth- or the sixth-order cumulants are
5478 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5479 call transpose2(AEA(1,1,1),auxmat(1,1))
5480 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5481 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5482 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5483 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5484 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5485 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5486 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5487 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5488 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5489 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5490 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5491 call transpose2(AEA(1,1,2),auxmat(1,1))
5492 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5493 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5494 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5495 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5496 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5497 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5498 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5499 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5500 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5501 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5502 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5503 C Calculate the Cartesian derivatives of the vectors.
5507 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5508 call matvec2(auxmat(1,1),b1(1,iti),
5509 & AEAb1derx(1,lll,kkk,iii,1,1))
5510 call matvec2(auxmat(1,1),Ub2(1,i),
5511 & AEAb2derx(1,lll,kkk,iii,1,1))
5512 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5513 & AEAb1derx(1,lll,kkk,iii,2,1))
5514 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5515 & AEAb2derx(1,lll,kkk,iii,2,1))
5516 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5517 call matvec2(auxmat(1,1),b1(1,itj),
5518 & AEAb1derx(1,lll,kkk,iii,1,2))
5519 call matvec2(auxmat(1,1),Ub2(1,j),
5520 & AEAb2derx(1,lll,kkk,iii,1,2))
5521 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5522 & AEAb1derx(1,lll,kkk,iii,2,2))
5523 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5524 & AEAb2derx(1,lll,kkk,iii,2,2))
5531 C Antiparallel orientation of the two CA-CA-CA frames.
5532 if (i.gt.1 .and. itype(i).le.ntyp) then
5533 iti=itortyp(itype(i))
5537 itk1=itortyp(itype(k+1))
5538 itl=itortyp(itype(l))
5539 itj=itortyp(itype(j))
5540 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5541 itj1=itortyp(itype(j+1))
5545 C A2 kernel(j-1)T A1T
5546 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5547 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5548 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5549 C Following matrices are needed only for 6-th order cumulants
5550 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5551 & j.eq.i+4 .and. l.eq.i+3)) THEN
5552 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5553 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5554 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5555 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5556 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5557 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5558 & ADtEAderx(1,1,1,1,1,1))
5559 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5560 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5561 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5562 & ADtEA1derx(1,1,1,1,1,1))
5564 C End 6-th order cumulants
5565 call transpose2(EUgder(1,1,k),auxmat(1,1))
5566 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5567 call transpose2(EUg(1,1,k),auxmat(1,1))
5568 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5569 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5573 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5574 & EAEAderx(1,1,lll,kkk,iii,1))
5578 C A2T kernel(i+1)T A1
5579 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5580 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5581 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5582 C Following matrices are needed only for 6-th order cumulants
5583 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5584 & j.eq.i+4 .and. l.eq.i+3)) THEN
5585 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5586 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5587 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5588 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5589 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5590 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5591 & ADtEAderx(1,1,1,1,1,2))
5592 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5593 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5594 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5595 & ADtEA1derx(1,1,1,1,1,2))
5597 C End 6-th order cumulants
5598 call transpose2(EUgder(1,1,j),auxmat(1,1))
5599 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5600 call transpose2(EUg(1,1,j),auxmat(1,1))
5601 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5602 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5606 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5607 & EAEAderx(1,1,lll,kkk,iii,2))
5612 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5613 C They are needed only when the fifth- or the sixth-order cumulants are
5615 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5616 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5617 call transpose2(AEA(1,1,1),auxmat(1,1))
5618 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5619 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5620 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5621 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5622 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5623 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5624 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5625 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5626 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5627 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5628 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5629 call transpose2(AEA(1,1,2),auxmat(1,1))
5630 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5631 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5632 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5633 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5634 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5635 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5636 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5637 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5638 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5639 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5640 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5641 C Calculate the Cartesian derivatives of the vectors.
5645 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5646 call matvec2(auxmat(1,1),b1(1,iti),
5647 & AEAb1derx(1,lll,kkk,iii,1,1))
5648 call matvec2(auxmat(1,1),Ub2(1,i),
5649 & AEAb2derx(1,lll,kkk,iii,1,1))
5650 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5651 & AEAb1derx(1,lll,kkk,iii,2,1))
5652 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5653 & AEAb2derx(1,lll,kkk,iii,2,1))
5654 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5655 call matvec2(auxmat(1,1),b1(1,itl),
5656 & AEAb1derx(1,lll,kkk,iii,1,2))
5657 call matvec2(auxmat(1,1),Ub2(1,l),
5658 & AEAb2derx(1,lll,kkk,iii,1,2))
5659 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5660 & AEAb1derx(1,lll,kkk,iii,2,2))
5661 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5662 & AEAb2derx(1,lll,kkk,iii,2,2))
5671 C---------------------------------------------------------------------------
5672 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5673 & KK,KKderg,AKA,AKAderg,AKAderx)
5677 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5678 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5679 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5684 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5686 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5689 cd if (lprn) write (2,*) 'In kernel'
5691 cd if (lprn) write (2,*) 'kkk=',kkk
5693 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5694 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5696 cd write (2,*) 'lll=',lll
5697 cd write (2,*) 'iii=1'
5699 cd write (2,'(3(2f10.5),5x)')
5700 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5703 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5704 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5706 cd write (2,*) 'lll=',lll
5707 cd write (2,*) 'iii=2'
5709 cd write (2,'(3(2f10.5),5x)')
5710 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5717 C---------------------------------------------------------------------------
5718 double precision function eello4(i,j,k,l,jj,kk)
5719 implicit real*8 (a-h,o-z)
5720 include 'DIMENSIONS'
5721 include 'DIMENSIONS.ZSCOPT'
5722 include 'COMMON.IOUNITS'
5723 include 'COMMON.CHAIN'
5724 include 'COMMON.DERIV'
5725 include 'COMMON.INTERACT'
5726 include 'COMMON.CONTACTS'
5727 include 'COMMON.TORSION'
5728 include 'COMMON.VAR'
5729 include 'COMMON.GEO'
5730 double precision pizda(2,2),ggg1(3),ggg2(3)
5731 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5735 cd print *,'eello4:',i,j,k,l,jj,kk
5736 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5737 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5738 cold eij=facont_hb(jj,i)
5739 cold ekl=facont_hb(kk,k)
5741 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5743 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5744 gcorr_loc(k-1)=gcorr_loc(k-1)
5745 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5747 gcorr_loc(l-1)=gcorr_loc(l-1)
5748 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5750 gcorr_loc(j-1)=gcorr_loc(j-1)
5751 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5756 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5757 & -EAEAderx(2,2,lll,kkk,iii,1)
5758 cd derx(lll,kkk,iii)=0.0d0
5762 cd gcorr_loc(l-1)=0.0d0
5763 cd gcorr_loc(j-1)=0.0d0
5764 cd gcorr_loc(k-1)=0.0d0
5766 cd write (iout,*)'Contacts have occurred for peptide groups',
5767 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5768 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5769 if (j.lt.nres-1) then
5776 if (l.lt.nres-1) then
5784 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5785 ggg1(ll)=eel4*g_contij(ll,1)
5786 ggg2(ll)=eel4*g_contij(ll,2)
5787 ghalf=0.5d0*ggg1(ll)
5789 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5790 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5791 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5792 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5793 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5794 ghalf=0.5d0*ggg2(ll)
5796 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5797 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5798 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5799 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5804 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5805 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5810 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5811 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5817 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5822 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5826 cd write (2,*) iii,gcorr_loc(iii)
5830 cd write (2,*) 'ekont',ekont
5831 cd write (iout,*) 'eello4',ekont*eel4
5834 C---------------------------------------------------------------------------
5835 double precision function eello5(i,j,k,l,jj,kk)
5836 implicit real*8 (a-h,o-z)
5837 include 'DIMENSIONS'
5838 include 'DIMENSIONS.ZSCOPT'
5839 include 'COMMON.IOUNITS'
5840 include 'COMMON.CHAIN'
5841 include 'COMMON.DERIV'
5842 include 'COMMON.INTERACT'
5843 include 'COMMON.CONTACTS'
5844 include 'COMMON.TORSION'
5845 include 'COMMON.VAR'
5846 include 'COMMON.GEO'
5847 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5848 double precision ggg1(3),ggg2(3)
5849 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5854 C /l\ / \ \ / \ / \ / C
5855 C / \ / \ \ / \ / \ / C
5856 C j| o |l1 | o | o| o | | o |o C
5857 C \ |/k\| |/ \| / |/ \| |/ \| C
5858 C \i/ \ / \ / / \ / \ C
5860 C (I) (II) (III) (IV) C
5862 C eello5_1 eello5_2 eello5_3 eello5_4 C
5864 C Antiparallel chains C
5867 C /j\ / \ \ / \ / \ / C
5868 C / \ / \ \ / \ / \ / C
5869 C j1| o |l | o | o| o | | o |o C
5870 C \ |/k\| |/ \| / |/ \| |/ \| C
5871 C \i/ \ / \ / / \ / \ C
5873 C (I) (II) (III) (IV) C
5875 C eello5_1 eello5_2 eello5_3 eello5_4 C
5877 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5879 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5880 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5885 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5887 itk=itortyp(itype(k))
5888 itl=itortyp(itype(l))
5889 itj=itortyp(itype(j))
5894 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5895 cd & eel5_3_num,eel5_4_num)
5899 derx(lll,kkk,iii)=0.0d0
5903 cd eij=facont_hb(jj,i)
5904 cd ekl=facont_hb(kk,k)
5906 cd write (iout,*)'Contacts have occurred for peptide groups',
5907 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5909 C Contribution from the graph I.
5910 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5911 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5912 call transpose2(EUg(1,1,k),auxmat(1,1))
5913 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5914 vv(1)=pizda(1,1)-pizda(2,2)
5915 vv(2)=pizda(1,2)+pizda(2,1)
5916 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5917 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5919 C Explicit gradient in virtual-dihedral angles.
5920 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5921 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5922 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5923 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5924 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5925 vv(1)=pizda(1,1)-pizda(2,2)
5926 vv(2)=pizda(1,2)+pizda(2,1)
5927 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5928 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5929 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5930 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5931 vv(1)=pizda(1,1)-pizda(2,2)
5932 vv(2)=pizda(1,2)+pizda(2,1)
5934 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5935 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5936 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5938 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5939 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5940 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5942 C Cartesian gradient
5946 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5948 vv(1)=pizda(1,1)-pizda(2,2)
5949 vv(2)=pizda(1,2)+pizda(2,1)
5950 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5951 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5952 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5959 C Contribution from graph II
5960 call transpose2(EE(1,1,itk),auxmat(1,1))
5961 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5962 vv(1)=pizda(1,1)+pizda(2,2)
5963 vv(2)=pizda(2,1)-pizda(1,2)
5964 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5965 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5967 C Explicit gradient in virtual-dihedral angles.
5968 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5969 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5970 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5971 vv(1)=pizda(1,1)+pizda(2,2)
5972 vv(2)=pizda(2,1)-pizda(1,2)
5974 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5975 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5976 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5978 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5979 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5980 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5982 C Cartesian gradient
5986 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5988 vv(1)=pizda(1,1)+pizda(2,2)
5989 vv(2)=pizda(2,1)-pizda(1,2)
5990 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5991 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5992 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6001 C Parallel orientation
6002 C Contribution from graph III
6003 call transpose2(EUg(1,1,l),auxmat(1,1))
6004 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6005 vv(1)=pizda(1,1)-pizda(2,2)
6006 vv(2)=pizda(1,2)+pizda(2,1)
6007 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6008 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6010 C Explicit gradient in virtual-dihedral angles.
6011 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6012 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6013 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6014 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6015 vv(1)=pizda(1,1)-pizda(2,2)
6016 vv(2)=pizda(1,2)+pizda(2,1)
6017 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6018 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6019 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6020 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6021 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6022 vv(1)=pizda(1,1)-pizda(2,2)
6023 vv(2)=pizda(1,2)+pizda(2,1)
6024 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6025 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6026 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6027 C Cartesian gradient
6031 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6033 vv(1)=pizda(1,1)-pizda(2,2)
6034 vv(2)=pizda(1,2)+pizda(2,1)
6035 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6036 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6037 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6043 C Contribution from graph IV
6045 call transpose2(EE(1,1,itl),auxmat(1,1))
6046 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6047 vv(1)=pizda(1,1)+pizda(2,2)
6048 vv(2)=pizda(2,1)-pizda(1,2)
6049 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6050 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6052 C Explicit gradient in virtual-dihedral angles.
6053 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6054 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6055 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6056 vv(1)=pizda(1,1)+pizda(2,2)
6057 vv(2)=pizda(2,1)-pizda(1,2)
6058 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6059 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6060 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6061 C Cartesian gradient
6065 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6067 vv(1)=pizda(1,1)+pizda(2,2)
6068 vv(2)=pizda(2,1)-pizda(1,2)
6069 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6070 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6071 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6077 C Antiparallel orientation
6078 C Contribution from graph III
6080 call transpose2(EUg(1,1,j),auxmat(1,1))
6081 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6082 vv(1)=pizda(1,1)-pizda(2,2)
6083 vv(2)=pizda(1,2)+pizda(2,1)
6084 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6085 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6087 C Explicit gradient in virtual-dihedral angles.
6088 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6089 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6090 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6091 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6092 vv(1)=pizda(1,1)-pizda(2,2)
6093 vv(2)=pizda(1,2)+pizda(2,1)
6094 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6095 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6096 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6097 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6098 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6099 vv(1)=pizda(1,1)-pizda(2,2)
6100 vv(2)=pizda(1,2)+pizda(2,1)
6101 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6102 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6103 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6104 C Cartesian gradient
6108 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6110 vv(1)=pizda(1,1)-pizda(2,2)
6111 vv(2)=pizda(1,2)+pizda(2,1)
6112 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6113 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6114 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6120 C Contribution from graph IV
6122 call transpose2(EE(1,1,itj),auxmat(1,1))
6123 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6124 vv(1)=pizda(1,1)+pizda(2,2)
6125 vv(2)=pizda(2,1)-pizda(1,2)
6126 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6127 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6129 C Explicit gradient in virtual-dihedral angles.
6130 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6131 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6132 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6133 vv(1)=pizda(1,1)+pizda(2,2)
6134 vv(2)=pizda(2,1)-pizda(1,2)
6135 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6136 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6137 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6138 C Cartesian gradient
6142 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6144 vv(1)=pizda(1,1)+pizda(2,2)
6145 vv(2)=pizda(2,1)-pizda(1,2)
6146 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6147 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6148 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6155 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6156 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6157 cd write (2,*) 'ijkl',i,j,k,l
6158 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6159 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6161 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6162 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6163 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6164 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6166 if (j.lt.nres-1) then
6173 if (l.lt.nres-1) then
6183 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6185 ggg1(ll)=eel5*g_contij(ll,1)
6186 ggg2(ll)=eel5*g_contij(ll,2)
6187 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6188 ghalf=0.5d0*ggg1(ll)
6190 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6191 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6192 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6193 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6194 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6195 ghalf=0.5d0*ggg2(ll)
6197 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6198 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6199 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6200 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6205 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6206 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6211 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6212 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6218 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6223 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6227 cd write (2,*) iii,g_corr5_loc(iii)
6231 cd write (2,*) 'ekont',ekont
6232 cd write (iout,*) 'eello5',ekont*eel5
6235 c--------------------------------------------------------------------------
6236 double precision function eello6(i,j,k,l,jj,kk)
6237 implicit real*8 (a-h,o-z)
6238 include 'DIMENSIONS'
6239 include 'DIMENSIONS.ZSCOPT'
6240 include 'COMMON.IOUNITS'
6241 include 'COMMON.CHAIN'
6242 include 'COMMON.DERIV'
6243 include 'COMMON.INTERACT'
6244 include 'COMMON.CONTACTS'
6245 include 'COMMON.TORSION'
6246 include 'COMMON.VAR'
6247 include 'COMMON.GEO'
6248 include 'COMMON.FFIELD'
6249 double precision ggg1(3),ggg2(3)
6250 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6255 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6263 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6264 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6268 derx(lll,kkk,iii)=0.0d0
6272 cd eij=facont_hb(jj,i)
6273 cd ekl=facont_hb(kk,k)
6279 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6280 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6281 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6282 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6283 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6284 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6286 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6287 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6288 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6289 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6290 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6291 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6295 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6297 C If turn contributions are considered, they will be handled separately.
6298 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6299 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6300 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6301 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6302 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6303 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6304 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6307 if (j.lt.nres-1) then
6314 if (l.lt.nres-1) then
6322 ggg1(ll)=eel6*g_contij(ll,1)
6323 ggg2(ll)=eel6*g_contij(ll,2)
6324 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6325 ghalf=0.5d0*ggg1(ll)
6327 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6328 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6329 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6330 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6331 ghalf=0.5d0*ggg2(ll)
6332 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6334 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6335 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6336 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6337 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6342 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6343 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6348 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6349 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6355 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6360 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6364 cd write (2,*) iii,g_corr6_loc(iii)
6368 cd write (2,*) 'ekont',ekont
6369 cd write (iout,*) 'eello6',ekont*eel6
6372 c--------------------------------------------------------------------------
6373 double precision function eello6_graph1(i,j,k,l,imat,swap)
6374 implicit real*8 (a-h,o-z)
6375 include 'DIMENSIONS'
6376 include 'DIMENSIONS.ZSCOPT'
6377 include 'COMMON.IOUNITS'
6378 include 'COMMON.CHAIN'
6379 include 'COMMON.DERIV'
6380 include 'COMMON.INTERACT'
6381 include 'COMMON.CONTACTS'
6382 include 'COMMON.TORSION'
6383 include 'COMMON.VAR'
6384 include 'COMMON.GEO'
6385 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6389 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6391 C Parallel Antiparallel C
6397 C \ j|/k\| / \ |/k\|l / C
6402 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6403 itk=itortyp(itype(k))
6404 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6405 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6406 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6407 call transpose2(EUgC(1,1,k),auxmat(1,1))
6408 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6409 vv1(1)=pizda1(1,1)-pizda1(2,2)
6410 vv1(2)=pizda1(1,2)+pizda1(2,1)
6411 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6412 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6413 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6414 s5=scalar2(vv(1),Dtobr2(1,i))
6415 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6416 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6417 if (.not. calc_grad) return
6418 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6419 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6420 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6421 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6422 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6423 & +scalar2(vv(1),Dtobr2der(1,i)))
6424 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6425 vv1(1)=pizda1(1,1)-pizda1(2,2)
6426 vv1(2)=pizda1(1,2)+pizda1(2,1)
6427 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6428 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6430 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6431 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6432 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6433 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6434 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6436 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6437 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6438 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6439 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6440 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6442 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6443 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6444 vv1(1)=pizda1(1,1)-pizda1(2,2)
6445 vv1(2)=pizda1(1,2)+pizda1(2,1)
6446 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6447 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6448 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6449 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6458 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6459 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6460 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6461 call transpose2(EUgC(1,1,k),auxmat(1,1))
6462 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6464 vv1(1)=pizda1(1,1)-pizda1(2,2)
6465 vv1(2)=pizda1(1,2)+pizda1(2,1)
6466 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6467 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6468 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6469 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6470 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6471 s5=scalar2(vv(1),Dtobr2(1,i))
6472 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6478 c----------------------------------------------------------------------------
6479 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6480 implicit real*8 (a-h,o-z)
6481 include 'DIMENSIONS'
6482 include 'DIMENSIONS.ZSCOPT'
6483 include 'COMMON.IOUNITS'
6484 include 'COMMON.CHAIN'
6485 include 'COMMON.DERIV'
6486 include 'COMMON.INTERACT'
6487 include 'COMMON.CONTACTS'
6488 include 'COMMON.TORSION'
6489 include 'COMMON.VAR'
6490 include 'COMMON.GEO'
6492 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6493 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6496 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6498 C Parallel Antiparallel C
6504 C \ j|/k\| \ |/k\|l C
6509 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6510 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6511 C AL 7/4/01 s1 would occur in the sixth-order moment,
6512 C but not in a cluster cumulant
6514 s1=dip(1,jj,i)*dip(1,kk,k)
6516 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6517 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6518 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6519 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6520 call transpose2(EUg(1,1,k),auxmat(1,1))
6521 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6522 vv(1)=pizda(1,1)-pizda(2,2)
6523 vv(2)=pizda(1,2)+pizda(2,1)
6524 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6525 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6527 eello6_graph2=-(s1+s2+s3+s4)
6529 eello6_graph2=-(s2+s3+s4)
6532 if (.not. calc_grad) return
6533 C Derivatives in gamma(i-1)
6536 s1=dipderg(1,jj,i)*dip(1,kk,k)
6538 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6539 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6540 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6541 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6543 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6545 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6547 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6549 C Derivatives in gamma(k-1)
6551 s1=dip(1,jj,i)*dipderg(1,kk,k)
6553 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6554 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6555 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6556 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6557 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6558 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6559 vv(1)=pizda(1,1)-pizda(2,2)
6560 vv(2)=pizda(1,2)+pizda(2,1)
6561 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6563 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6565 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6567 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6568 C Derivatives in gamma(j-1) or gamma(l-1)
6571 s1=dipderg(3,jj,i)*dip(1,kk,k)
6573 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6574 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6575 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6576 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6577 vv(1)=pizda(1,1)-pizda(2,2)
6578 vv(2)=pizda(1,2)+pizda(2,1)
6579 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6582 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6584 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6587 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6588 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6590 C Derivatives in gamma(l-1) or gamma(j-1)
6593 s1=dip(1,jj,i)*dipderg(3,kk,k)
6595 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6596 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6597 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6598 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6599 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6600 vv(1)=pizda(1,1)-pizda(2,2)
6601 vv(2)=pizda(1,2)+pizda(2,1)
6602 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6605 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6607 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6610 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6611 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6613 C Cartesian derivatives.
6615 write (2,*) 'In eello6_graph2'
6617 write (2,*) 'iii=',iii
6619 write (2,*) 'kkk=',kkk
6621 write (2,'(3(2f10.5),5x)')
6622 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6632 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6634 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6637 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6639 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6640 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6642 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6643 call transpose2(EUg(1,1,k),auxmat(1,1))
6644 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6646 vv(1)=pizda(1,1)-pizda(2,2)
6647 vv(2)=pizda(1,2)+pizda(2,1)
6648 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6649 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6651 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6653 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6656 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6658 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6665 c----------------------------------------------------------------------------
6666 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6667 implicit real*8 (a-h,o-z)
6668 include 'DIMENSIONS'
6669 include 'DIMENSIONS.ZSCOPT'
6670 include 'COMMON.IOUNITS'
6671 include 'COMMON.CHAIN'
6672 include 'COMMON.DERIV'
6673 include 'COMMON.INTERACT'
6674 include 'COMMON.CONTACTS'
6675 include 'COMMON.TORSION'
6676 include 'COMMON.VAR'
6677 include 'COMMON.GEO'
6678 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6680 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6682 C Parallel Antiparallel C
6688 C j|/k\| / |/k\|l / C
6693 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6695 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6696 C energy moment and not to the cluster cumulant.
6697 iti=itortyp(itype(i))
6698 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6699 itj1=itortyp(itype(j+1))
6703 itk=itortyp(itype(k))
6704 itk1=itortyp(itype(k+1))
6705 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6706 itl1=itortyp(itype(l+1))
6711 s1=dip(4,jj,i)*dip(4,kk,k)
6713 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6714 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6715 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6716 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6717 call transpose2(EE(1,1,itk),auxmat(1,1))
6718 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6719 vv(1)=pizda(1,1)+pizda(2,2)
6720 vv(2)=pizda(2,1)-pizda(1,2)
6721 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6722 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6724 eello6_graph3=-(s1+s2+s3+s4)
6726 eello6_graph3=-(s2+s3+s4)
6729 if (.not. calc_grad) return
6730 C Derivatives in gamma(k-1)
6731 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6732 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6733 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6734 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6735 C Derivatives in gamma(l-1)
6736 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6737 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6738 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6739 vv(1)=pizda(1,1)+pizda(2,2)
6740 vv(2)=pizda(2,1)-pizda(1,2)
6741 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6742 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6743 C Cartesian derivatives.
6749 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6751 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6754 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6756 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6757 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6759 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6760 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6762 vv(1)=pizda(1,1)+pizda(2,2)
6763 vv(2)=pizda(2,1)-pizda(1,2)
6764 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6766 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6768 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6771 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6773 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6775 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6781 c----------------------------------------------------------------------------
6782 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6783 implicit real*8 (a-h,o-z)
6784 include 'DIMENSIONS'
6785 include 'DIMENSIONS.ZSCOPT'
6786 include 'COMMON.IOUNITS'
6787 include 'COMMON.CHAIN'
6788 include 'COMMON.DERIV'
6789 include 'COMMON.INTERACT'
6790 include 'COMMON.CONTACTS'
6791 include 'COMMON.TORSION'
6792 include 'COMMON.VAR'
6793 include 'COMMON.GEO'
6794 include 'COMMON.FFIELD'
6795 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6796 & auxvec1(2),auxmat1(2,2)
6798 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6800 C Parallel Antiparallel C
6806 C \ j|/k\| \ |/k\|l C
6811 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6813 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6814 C energy moment and not to the cluster cumulant.
6815 cd write (2,*) 'eello_graph4: wturn6',wturn6
6816 iti=itortyp(itype(i))
6817 itj=itortyp(itype(j))
6818 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6819 itj1=itortyp(itype(j+1))
6823 itk=itortyp(itype(k))
6824 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6825 itk1=itortyp(itype(k+1))
6829 itl=itortyp(itype(l))
6830 if (l.lt.nres-1) then
6831 itl1=itortyp(itype(l+1))
6835 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6836 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6837 cd & ' itl',itl,' itl1',itl1
6840 s1=dip(3,jj,i)*dip(3,kk,k)
6842 s1=dip(2,jj,j)*dip(2,kk,l)
6845 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6846 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6848 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6849 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6851 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6852 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6854 call transpose2(EUg(1,1,k),auxmat(1,1))
6855 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6856 vv(1)=pizda(1,1)-pizda(2,2)
6857 vv(2)=pizda(2,1)+pizda(1,2)
6858 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6859 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6861 eello6_graph4=-(s1+s2+s3+s4)
6863 eello6_graph4=-(s2+s3+s4)
6865 if (.not. calc_grad) return
6866 C Derivatives in gamma(i-1)
6870 s1=dipderg(2,jj,i)*dip(3,kk,k)
6872 s1=dipderg(4,jj,j)*dip(2,kk,l)
6875 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6877 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6878 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6880 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6881 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6883 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6884 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6885 cd write (2,*) 'turn6 derivatives'
6887 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6889 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6893 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6895 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6899 C Derivatives in gamma(k-1)
6902 s1=dip(3,jj,i)*dipderg(2,kk,k)
6904 s1=dip(2,jj,j)*dipderg(4,kk,l)
6907 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6908 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6910 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6911 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6913 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6914 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6916 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6917 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6918 vv(1)=pizda(1,1)-pizda(2,2)
6919 vv(2)=pizda(2,1)+pizda(1,2)
6920 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6921 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6923 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6925 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6929 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6931 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6934 C Derivatives in gamma(j-1) or gamma(l-1)
6935 if (l.eq.j+1 .and. l.gt.1) then
6936 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6937 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6938 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6939 vv(1)=pizda(1,1)-pizda(2,2)
6940 vv(2)=pizda(2,1)+pizda(1,2)
6941 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6942 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6943 else if (j.gt.1) then
6944 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6945 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6946 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6947 vv(1)=pizda(1,1)-pizda(2,2)
6948 vv(2)=pizda(2,1)+pizda(1,2)
6949 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6950 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6951 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6953 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6956 C Cartesian derivatives.
6963 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6965 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6969 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6971 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6975 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6977 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6979 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6980 & b1(1,itj1),auxvec(1))
6981 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6983 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6984 & b1(1,itl1),auxvec(1))
6985 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6987 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6989 vv(1)=pizda(1,1)-pizda(2,2)
6990 vv(2)=pizda(2,1)+pizda(1,2)
6991 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6993 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6995 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6998 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7001 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7004 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7006 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7008 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7012 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7014 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7017 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7019 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7027 c----------------------------------------------------------------------------
7028 double precision function eello_turn6(i,jj,kk)
7029 implicit real*8 (a-h,o-z)
7030 include 'DIMENSIONS'
7031 include 'DIMENSIONS.ZSCOPT'
7032 include 'COMMON.IOUNITS'
7033 include 'COMMON.CHAIN'
7034 include 'COMMON.DERIV'
7035 include 'COMMON.INTERACT'
7036 include 'COMMON.CONTACTS'
7037 include 'COMMON.TORSION'
7038 include 'COMMON.VAR'
7039 include 'COMMON.GEO'
7040 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7041 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7043 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7044 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7045 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7046 C the respective energy moment and not to the cluster cumulant.
7051 iti=itortyp(itype(i))
7052 itk=itortyp(itype(k))
7053 itk1=itortyp(itype(k+1))
7054 itl=itortyp(itype(l))
7055 itj=itortyp(itype(j))
7056 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7057 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7058 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7063 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7065 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7069 derx_turn(lll,kkk,iii)=0.0d0
7076 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7078 cd write (2,*) 'eello6_5',eello6_5
7080 call transpose2(AEA(1,1,1),auxmat(1,1))
7081 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7082 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7083 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7087 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7088 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7089 s2 = scalar2(b1(1,itk),vtemp1(1))
7091 call transpose2(AEA(1,1,2),atemp(1,1))
7092 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7093 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7094 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7098 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7099 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7100 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7102 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7103 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7104 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7105 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7106 ss13 = scalar2(b1(1,itk),vtemp4(1))
7107 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7111 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7117 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7119 C Derivatives in gamma(i+2)
7121 call transpose2(AEA(1,1,1),auxmatd(1,1))
7122 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7123 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7124 call transpose2(AEAderg(1,1,2),atempd(1,1))
7125 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7126 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7130 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7131 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7132 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7138 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7139 C Derivatives in gamma(i+3)
7141 call transpose2(AEA(1,1,1),auxmatd(1,1))
7142 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7143 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7144 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7148 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7149 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7150 s2d = scalar2(b1(1,itk),vtemp1d(1))
7152 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7153 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7155 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7157 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7158 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7159 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7169 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7170 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7172 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7173 & -0.5d0*ekont*(s2d+s12d)
7175 C Derivatives in gamma(i+4)
7176 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7177 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7178 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7180 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7181 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7182 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7192 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7194 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7196 C Derivatives in gamma(i+5)
7198 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7199 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7200 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7204 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7205 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7206 s2d = scalar2(b1(1,itk),vtemp1d(1))
7208 call transpose2(AEA(1,1,2),atempd(1,1))
7209 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7210 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7214 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7215 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7217 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7218 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7219 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7229 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7230 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7232 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7233 & -0.5d0*ekont*(s2d+s12d)
7235 C Cartesian derivatives
7240 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7241 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7242 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7246 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7247 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7249 s2d = scalar2(b1(1,itk),vtemp1d(1))
7251 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7252 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7253 s8d = -(atempd(1,1)+atempd(2,2))*
7254 & scalar2(cc(1,1,itl),vtemp2(1))
7258 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7260 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7261 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7268 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7271 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7275 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7276 & - 0.5d0*(s8d+s12d)
7278 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7287 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7289 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7290 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7291 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7292 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7293 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7295 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7296 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7297 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7301 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7302 cd & 16*eel_turn6_num
7304 if (j.lt.nres-1) then
7311 if (l.lt.nres-1) then
7319 ggg1(ll)=eel_turn6*g_contij(ll,1)
7320 ggg2(ll)=eel_turn6*g_contij(ll,2)
7321 ghalf=0.5d0*ggg1(ll)
7323 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7324 & +ekont*derx_turn(ll,2,1)
7325 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7326 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7327 & +ekont*derx_turn(ll,4,1)
7328 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7329 ghalf=0.5d0*ggg2(ll)
7331 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7332 & +ekont*derx_turn(ll,2,2)
7333 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7334 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7335 & +ekont*derx_turn(ll,4,2)
7336 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7341 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7346 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7352 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7357 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7361 cd write (2,*) iii,g_corr6_loc(iii)
7364 eello_turn6=ekont*eel_turn6
7365 cd write (2,*) 'ekont',ekont
7366 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7369 crc-------------------------------------------------
7370 SUBROUTINE MATVEC2(A1,V1,V2)
7371 implicit real*8 (a-h,o-z)
7372 include 'DIMENSIONS'
7373 DIMENSION A1(2,2),V1(2),V2(2)
7377 c 3 VI=VI+A1(I,K)*V1(K)
7381 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7382 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7387 C---------------------------------------
7388 SUBROUTINE MATMAT2(A1,A2,A3)
7389 implicit real*8 (a-h,o-z)
7390 include 'DIMENSIONS'
7391 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7392 c DIMENSION AI3(2,2)
7396 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7402 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7403 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7404 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7405 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7413 c-------------------------------------------------------------------------
7414 double precision function scalar2(u,v)
7416 double precision u(2),v(2)
7419 scalar2=u(1)*v(1)+u(2)*v(2)
7423 C-----------------------------------------------------------------------------
7425 subroutine transpose2(a,at)
7427 double precision a(2,2),at(2,2)
7434 c--------------------------------------------------------------------------
7435 subroutine transpose(n,a,at)
7438 double precision a(n,n),at(n,n)
7446 C---------------------------------------------------------------------------
7447 subroutine prodmat3(a1,a2,kk,transp,prod)
7450 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7452 crc double precision auxmat(2,2),prod_(2,2)
7455 crc call transpose2(kk(1,1),auxmat(1,1))
7456 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7457 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7459 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7460 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7461 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7462 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7463 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7464 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7465 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7466 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7469 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7470 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7472 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7473 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7474 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7475 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7476 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7477 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7478 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7479 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7482 c call transpose2(a2(1,1),a2t(1,1))
7485 crc print *,((prod_(i,j),i=1,2),j=1,2)
7486 crc print *,((prod(i,j),i=1,2),j=1,2)
7490 C-----------------------------------------------------------------------------
7491 double precision function scalar(u,v)
7493 double precision u(3),v(3)