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 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
1920 c &'evdw1',i,j,evdwij
1921 c &,iteli,itelj,aaa,evdw1
1923 c write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
1924 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1925 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1926 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1927 c & xmedi,ymedi,zmedi,xj,yj,zj
1929 C Calculate contributions to the Cartesian gradient.
1932 facvdw=-6*rrmij*(ev1+evdwij)
1933 facel=-3*rrmij*(el1+eesij)
1940 * Radial derivatives. First process both termini of the fragment (i,j)
1947 gelc(k,i)=gelc(k,i)+ghalf
1948 gelc(k,j)=gelc(k,j)+ghalf
1951 * Loop over residues i+1 thru j-1.
1955 gelc(l,k)=gelc(l,k)+ggg(l)
1963 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1964 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1967 * Loop over residues i+1 thru j-1.
1971 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1978 fac=-3*rrmij*(facvdw+facvdw+facel)
1984 * Radial derivatives. First process both termini of the fragment (i,j)
1991 gelc(k,i)=gelc(k,i)+ghalf
1992 gelc(k,j)=gelc(k,j)+ghalf
1995 * Loop over residues i+1 thru j-1.
1999 gelc(l,k)=gelc(l,k)+ggg(l)
2006 ecosa=2.0D0*fac3*fac1+fac4
2009 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2010 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2012 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2013 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2015 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2016 cd & (dcosg(k),k=1,3)
2018 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2022 gelc(k,i)=gelc(k,i)+ghalf
2023 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2024 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2025 gelc(k,j)=gelc(k,j)+ghalf
2026 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2027 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2031 gelc(l,k)=gelc(l,k)+ggg(l)
2036 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2037 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2038 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2040 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2041 C energy of a peptide unit is assumed in the form of a second-order
2042 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2043 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2044 C are computed for EVERY pair of non-contiguous peptide groups.
2046 if (j.lt.nres-1) then
2057 muij(kkk)=mu(k,i)*mu(l,j)
2060 cd write (iout,*) 'EELEC: i',i,' j',j
2061 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2062 cd write(iout,*) 'muij',muij
2063 ury=scalar(uy(1,i),erij)
2064 urz=scalar(uz(1,i),erij)
2065 vry=scalar(uy(1,j),erij)
2066 vrz=scalar(uz(1,j),erij)
2067 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2068 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2069 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2070 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2071 C For diagnostics only
2076 fac=dsqrt(-ael6i)*r3ij
2077 cd write (2,*) 'fac=',fac
2078 C For diagnostics only
2084 cd write (iout,'(4i5,4f10.5)')
2085 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2086 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2087 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2088 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2089 cd write (iout,'(4f10.5)')
2090 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2091 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2092 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2093 cd write (iout,'(2i3,9f10.5/)') i,j,
2094 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2096 C Derivatives of the elements of A in virtual-bond vectors
2097 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2104 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2105 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2106 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2107 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2108 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2109 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2110 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2111 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2112 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2113 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2114 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2115 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2125 C Compute radial contributions to the gradient
2147 C Add the contributions coming from er
2150 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2151 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2152 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2153 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2156 C Derivatives in DC(i)
2157 ghalf1=0.5d0*agg(k,1)
2158 ghalf2=0.5d0*agg(k,2)
2159 ghalf3=0.5d0*agg(k,3)
2160 ghalf4=0.5d0*agg(k,4)
2161 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2162 & -3.0d0*uryg(k,2)*vry)+ghalf1
2163 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2164 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2165 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2166 & -3.0d0*urzg(k,2)*vry)+ghalf3
2167 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2168 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2169 C Derivatives in DC(i+1)
2170 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2171 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2172 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2173 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2174 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2175 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2176 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2177 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2178 C Derivatives in DC(j)
2179 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2180 & -3.0d0*vryg(k,2)*ury)+ghalf1
2181 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2182 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2183 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2184 & -3.0d0*vryg(k,2)*urz)+ghalf3
2185 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2186 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2187 C Derivatives in DC(j+1) or DC(nres-1)
2188 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2189 & -3.0d0*vryg(k,3)*ury)
2190 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2191 & -3.0d0*vrzg(k,3)*ury)
2192 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2193 & -3.0d0*vryg(k,3)*urz)
2194 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2195 & -3.0d0*vrzg(k,3)*urz)
2200 C Derivatives in DC(i+1)
2201 cd aggi1(k,1)=agg(k,1)
2202 cd aggi1(k,2)=agg(k,2)
2203 cd aggi1(k,3)=agg(k,3)
2204 cd aggi1(k,4)=agg(k,4)
2205 C Derivatives in DC(j)
2210 C Derivatives in DC(j+1)
2215 if (j.eq.nres-1 .and. i.lt.j-2) then
2217 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2218 cd aggj1(k,l)=agg(k,l)
2224 C Check the loc-el terms by numerical integration
2234 aggi(k,l)=-aggi(k,l)
2235 aggi1(k,l)=-aggi1(k,l)
2236 aggj(k,l)=-aggj(k,l)
2237 aggj1(k,l)=-aggj1(k,l)
2240 if (j.lt.nres-1) then
2246 aggi(k,l)=-aggi(k,l)
2247 aggi1(k,l)=-aggi1(k,l)
2248 aggj(k,l)=-aggj(k,l)
2249 aggj1(k,l)=-aggj1(k,l)
2260 aggi(k,l)=-aggi(k,l)
2261 aggi1(k,l)=-aggi1(k,l)
2262 aggj(k,l)=-aggj(k,l)
2263 aggj1(k,l)=-aggj1(k,l)
2269 IF (wel_loc.gt.0.0d0) THEN
2270 C Contribution to the local-electrostatic energy coming from the i-j pair
2271 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2273 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2274 c write (iout,'(a6,2i5,0pf7.3)')
2275 c & 'eelloc',i,j,eel_loc_ij
2276 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2277 eel_loc=eel_loc+eel_loc_ij
2278 C Partial derivatives in virtual-bond dihedral angles gamma
2281 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2282 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2283 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2284 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2285 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2286 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2287 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2288 cd write(iout,*) 'agg ',agg
2289 cd write(iout,*) 'aggi ',aggi
2290 cd write(iout,*) 'aggi1',aggi1
2291 cd write(iout,*) 'aggj ',aggj
2292 cd write(iout,*) 'aggj1',aggj1
2294 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2296 ggg(l)=agg(l,1)*muij(1)+
2297 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2301 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2304 C Remaining derivatives of eello
2306 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2307 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2308 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2309 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2310 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2311 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2312 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2313 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2317 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2318 C Contributions from turns
2323 call eturn34(i,j,eello_turn3,eello_turn4)
2325 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2326 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2328 C Calculate the contact function. The ith column of the array JCONT will
2329 C contain the numbers of atoms that make contacts with the atom I (of numbers
2330 C greater than I). The arrays FACONT and GACONT will contain the values of
2331 C the contact function and its derivative.
2332 c r0ij=1.02D0*rpp(iteli,itelj)
2333 c r0ij=1.11D0*rpp(iteli,itelj)
2334 r0ij=2.20D0*rpp(iteli,itelj)
2335 c r0ij=1.55D0*rpp(iteli,itelj)
2336 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2337 if (fcont.gt.0.0D0) then
2338 num_conti=num_conti+1
2339 if (num_conti.gt.maxconts) then
2340 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2341 & ' will skip next contacts for this conf.'
2343 jcont_hb(num_conti,i)=j
2344 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2345 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2346 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2348 d_cont(num_conti,i)=rij
2349 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2350 C --- Electrostatic-interaction matrix ---
2351 a_chuj(1,1,num_conti,i)=a22
2352 a_chuj(1,2,num_conti,i)=a23
2353 a_chuj(2,1,num_conti,i)=a32
2354 a_chuj(2,2,num_conti,i)=a33
2355 C --- Gradient of rij
2357 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2360 c a_chuj(1,1,num_conti,i)=-0.61d0
2361 c a_chuj(1,2,num_conti,i)= 0.4d0
2362 c a_chuj(2,1,num_conti,i)= 0.65d0
2363 c a_chuj(2,2,num_conti,i)= 0.50d0
2364 c else if (i.eq.2) then
2365 c a_chuj(1,1,num_conti,i)= 0.0d0
2366 c a_chuj(1,2,num_conti,i)= 0.0d0
2367 c a_chuj(2,1,num_conti,i)= 0.0d0
2368 c a_chuj(2,2,num_conti,i)= 0.0d0
2370 C --- and its gradients
2371 cd write (iout,*) 'i',i,' j',j
2373 cd write (iout,*) 'iii 1 kkk',kkk
2374 cd write (iout,*) agg(kkk,:)
2377 cd write (iout,*) 'iii 2 kkk',kkk
2378 cd write (iout,*) aggi(kkk,:)
2381 cd write (iout,*) 'iii 3 kkk',kkk
2382 cd write (iout,*) aggi1(kkk,:)
2385 cd write (iout,*) 'iii 4 kkk',kkk
2386 cd write (iout,*) aggj(kkk,:)
2389 cd write (iout,*) 'iii 5 kkk',kkk
2390 cd write (iout,*) aggj1(kkk,:)
2397 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2398 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2399 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2400 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2401 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2403 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2409 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2410 C Calculate contact energies
2412 wij=cosa-3.0D0*cosb*cosg
2415 c fac3=dsqrt(-ael6i)/r0ij**3
2416 fac3=dsqrt(-ael6i)*r3ij
2417 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2418 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2420 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2421 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2422 C Diagnostics. Comment out or remove after debugging!
2423 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2424 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2425 c ees0m(num_conti,i)=0.0D0
2427 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2428 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2429 facont_hb(num_conti,i)=fcont
2431 C Angular derivatives of the contact function
2432 ees0pij1=fac3/ees0pij
2433 ees0mij1=fac3/ees0mij
2434 fac3p=-3.0D0*fac3*rrmij
2435 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2436 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2438 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2439 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2440 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2441 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2442 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2443 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2444 ecosap=ecosa1+ecosa2
2445 ecosbp=ecosb1+ecosb2
2446 ecosgp=ecosg1+ecosg2
2447 ecosam=ecosa1-ecosa2
2448 ecosbm=ecosb1-ecosb2
2449 ecosgm=ecosg1-ecosg2
2458 fprimcont=fprimcont/rij
2459 cd facont_hb(num_conti,i)=1.0D0
2460 C Following line is for diagnostics.
2463 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2464 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2467 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2468 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2470 gggp(1)=gggp(1)+ees0pijp*xj
2471 gggp(2)=gggp(2)+ees0pijp*yj
2472 gggp(3)=gggp(3)+ees0pijp*zj
2473 gggm(1)=gggm(1)+ees0mijp*xj
2474 gggm(2)=gggm(2)+ees0mijp*yj
2475 gggm(3)=gggm(3)+ees0mijp*zj
2476 C Derivatives due to the contact function
2477 gacont_hbr(1,num_conti,i)=fprimcont*xj
2478 gacont_hbr(2,num_conti,i)=fprimcont*yj
2479 gacont_hbr(3,num_conti,i)=fprimcont*zj
2481 ghalfp=0.5D0*gggp(k)
2482 ghalfm=0.5D0*gggm(k)
2483 gacontp_hb1(k,num_conti,i)=ghalfp
2484 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2485 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2486 gacontp_hb2(k,num_conti,i)=ghalfp
2487 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2488 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2489 gacontp_hb3(k,num_conti,i)=gggp(k)
2490 gacontm_hb1(k,num_conti,i)=ghalfm
2491 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2492 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2493 gacontm_hb2(k,num_conti,i)=ghalfm
2494 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2495 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2496 gacontm_hb3(k,num_conti,i)=gggm(k)
2499 C Diagnostics. Comment out or remove after debugging!
2501 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2502 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2503 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2504 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2505 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2506 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2509 endif ! num_conti.le.maxconts
2514 num_cont_hb(i)=num_conti
2518 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2519 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2521 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2522 ccc eel_loc=eel_loc+eello_turn3
2525 C-----------------------------------------------------------------------------
2526 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2527 C Third- and fourth-order contributions from turns
2528 implicit real*8 (a-h,o-z)
2529 include 'DIMENSIONS'
2530 include 'DIMENSIONS.ZSCOPT'
2531 include 'COMMON.IOUNITS'
2532 include 'COMMON.GEO'
2533 include 'COMMON.VAR'
2534 include 'COMMON.LOCAL'
2535 include 'COMMON.CHAIN'
2536 include 'COMMON.DERIV'
2537 include 'COMMON.INTERACT'
2538 include 'COMMON.CONTACTS'
2539 include 'COMMON.TORSION'
2540 include 'COMMON.VECTORS'
2541 include 'COMMON.FFIELD'
2543 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2544 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2545 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2546 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2547 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2548 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2550 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2552 C Third-order contributions
2559 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2560 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2561 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2562 call transpose2(auxmat(1,1),auxmat1(1,1))
2563 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2564 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2565 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2566 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2567 cd & ' eello_turn3_num',4*eello_turn3_num
2569 C Derivatives in gamma(i)
2570 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2571 call transpose2(auxmat2(1,1),pizda(1,1))
2572 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2573 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2574 C Derivatives in gamma(i+1)
2575 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2576 call transpose2(auxmat2(1,1),pizda(1,1))
2577 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2578 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2579 & +0.5d0*(pizda(1,1)+pizda(2,2))
2580 C Cartesian derivatives
2582 a_temp(1,1)=aggi(l,1)
2583 a_temp(1,2)=aggi(l,2)
2584 a_temp(2,1)=aggi(l,3)
2585 a_temp(2,2)=aggi(l,4)
2586 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2587 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2588 & +0.5d0*(pizda(1,1)+pizda(2,2))
2589 a_temp(1,1)=aggi1(l,1)
2590 a_temp(1,2)=aggi1(l,2)
2591 a_temp(2,1)=aggi1(l,3)
2592 a_temp(2,2)=aggi1(l,4)
2593 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2594 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2595 & +0.5d0*(pizda(1,1)+pizda(2,2))
2596 a_temp(1,1)=aggj(l,1)
2597 a_temp(1,2)=aggj(l,2)
2598 a_temp(2,1)=aggj(l,3)
2599 a_temp(2,2)=aggj(l,4)
2600 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2601 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2602 & +0.5d0*(pizda(1,1)+pizda(2,2))
2603 a_temp(1,1)=aggj1(l,1)
2604 a_temp(1,2)=aggj1(l,2)
2605 a_temp(2,1)=aggj1(l,3)
2606 a_temp(2,2)=aggj1(l,4)
2607 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2608 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2609 & +0.5d0*(pizda(1,1)+pizda(2,2))
2612 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2613 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2615 C Fourth-order contributions
2623 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2624 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2625 iti1=itortyp(itype(i+1))
2626 iti2=itortyp(itype(i+2))
2627 iti3=itortyp(itype(i+3))
2628 call transpose2(EUg(1,1,i+1),e1t(1,1))
2629 call transpose2(Eug(1,1,i+2),e2t(1,1))
2630 call transpose2(Eug(1,1,i+3),e3t(1,1))
2631 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2632 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2633 s1=scalar2(b1(1,iti2),auxvec(1))
2634 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2635 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2636 s2=scalar2(b1(1,iti1),auxvec(1))
2637 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2638 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2639 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2640 eello_turn4=eello_turn4-(s1+s2+s3)
2641 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2642 cd & ' eello_turn4_num',8*eello_turn4_num
2643 C Derivatives in gamma(i)
2645 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2646 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2647 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2648 s1=scalar2(b1(1,iti2),auxvec(1))
2649 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2650 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2651 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2652 C Derivatives in gamma(i+1)
2653 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2654 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2655 s2=scalar2(b1(1,iti1),auxvec(1))
2656 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2657 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2658 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2659 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2660 C Derivatives in gamma(i+2)
2661 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2662 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2663 s1=scalar2(b1(1,iti2),auxvec(1))
2664 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2665 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2666 s2=scalar2(b1(1,iti1),auxvec(1))
2667 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2668 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2669 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2670 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2671 C Cartesian derivatives
2672 C Derivatives of this turn contributions in DC(i+2)
2673 if (j.lt.nres-1) then
2675 a_temp(1,1)=agg(l,1)
2676 a_temp(1,2)=agg(l,2)
2677 a_temp(2,1)=agg(l,3)
2678 a_temp(2,2)=agg(l,4)
2679 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2680 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2681 s1=scalar2(b1(1,iti2),auxvec(1))
2682 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2683 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2684 s2=scalar2(b1(1,iti1),auxvec(1))
2685 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2686 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2687 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2689 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2692 C Remaining derivatives of this turn contribution
2694 a_temp(1,1)=aggi(l,1)
2695 a_temp(1,2)=aggi(l,2)
2696 a_temp(2,1)=aggi(l,3)
2697 a_temp(2,2)=aggi(l,4)
2698 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2699 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2700 s1=scalar2(b1(1,iti2),auxvec(1))
2701 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2702 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2703 s2=scalar2(b1(1,iti1),auxvec(1))
2704 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2705 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2706 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2707 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2708 a_temp(1,1)=aggi1(l,1)
2709 a_temp(1,2)=aggi1(l,2)
2710 a_temp(2,1)=aggi1(l,3)
2711 a_temp(2,2)=aggi1(l,4)
2712 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2713 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2714 s1=scalar2(b1(1,iti2),auxvec(1))
2715 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2716 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2717 s2=scalar2(b1(1,iti1),auxvec(1))
2718 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2719 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2720 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2721 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2722 a_temp(1,1)=aggj(l,1)
2723 a_temp(1,2)=aggj(l,2)
2724 a_temp(2,1)=aggj(l,3)
2725 a_temp(2,2)=aggj(l,4)
2726 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2727 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2728 s1=scalar2(b1(1,iti2),auxvec(1))
2729 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2730 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2731 s2=scalar2(b1(1,iti1),auxvec(1))
2732 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2733 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2734 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2735 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2736 a_temp(1,1)=aggj1(l,1)
2737 a_temp(1,2)=aggj1(l,2)
2738 a_temp(2,1)=aggj1(l,3)
2739 a_temp(2,2)=aggj1(l,4)
2740 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2741 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2742 s1=scalar2(b1(1,iti2),auxvec(1))
2743 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2744 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2745 s2=scalar2(b1(1,iti1),auxvec(1))
2746 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2747 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2748 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2749 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2755 C-----------------------------------------------------------------------------
2756 subroutine vecpr(u,v,w)
2757 implicit real*8(a-h,o-z)
2758 dimension u(3),v(3),w(3)
2759 w(1)=u(2)*v(3)-u(3)*v(2)
2760 w(2)=-u(1)*v(3)+u(3)*v(1)
2761 w(3)=u(1)*v(2)-u(2)*v(1)
2764 C-----------------------------------------------------------------------------
2765 subroutine unormderiv(u,ugrad,unorm,ungrad)
2766 C This subroutine computes the derivatives of a normalized vector u, given
2767 C the derivatives computed without normalization conditions, ugrad. Returns
2770 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2771 double precision vec(3)
2772 double precision scalar
2774 c write (2,*) 'ugrad',ugrad
2777 vec(i)=scalar(ugrad(1,i),u(1))
2779 c write (2,*) 'vec',vec
2782 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2785 c write (2,*) 'ungrad',ungrad
2788 C-----------------------------------------------------------------------------
2789 subroutine escp(evdw2,evdw2_14)
2791 C This subroutine calculates the excluded-volume interaction energy between
2792 C peptide-group centers and side chains and its gradient in virtual-bond and
2793 C side-chain vectors.
2795 implicit real*8 (a-h,o-z)
2796 include 'DIMENSIONS'
2797 include 'DIMENSIONS.ZSCOPT'
2798 include 'COMMON.GEO'
2799 include 'COMMON.VAR'
2800 include 'COMMON.LOCAL'
2801 include 'COMMON.CHAIN'
2802 include 'COMMON.DERIV'
2803 include 'COMMON.INTERACT'
2804 include 'COMMON.FFIELD'
2805 include 'COMMON.IOUNITS'
2809 cd print '(a)','Enter ESCP'
2810 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2811 c & ' scal14',scal14
2812 do i=iatscp_s,iatscp_e
2813 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2815 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2816 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2817 if (iteli.eq.0) goto 1225
2818 xi=0.5D0*(c(1,i)+c(1,i+1))
2819 yi=0.5D0*(c(2,i)+c(2,i+1))
2820 zi=0.5D0*(c(3,i)+c(3,i+1))
2822 do iint=1,nscp_gr(i)
2824 do j=iscpstart(i,iint),iscpend(i,iint)
2825 itypj=iabs(itype(j))
2826 if (itypj.eq.ntyp1) cycle
2827 C Uncomment following three lines for SC-p interactions
2831 C Uncomment following three lines for Ca-p interactions
2835 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2837 e1=fac*fac*aad(itypj,iteli)
2838 e2=fac*bad(itypj,iteli)
2839 if (iabs(j-i) .le. 2) then
2842 evdw2_14=evdw2_14+e1+e2
2845 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
2846 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
2847 c & bad(itypj,iteli)
2851 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2853 fac=-(evdwij+e1)*rrij
2858 cd write (iout,*) 'j<i'
2859 C Uncomment following three lines for SC-p interactions
2861 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2864 cd write (iout,*) 'j>i'
2867 C Uncomment following line for SC-p interactions
2868 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2872 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2876 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2877 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2880 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2890 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2891 gradx_scp(j,i)=expon*gradx_scp(j,i)
2894 C******************************************************************************
2898 C To save time the factor EXPON has been extracted from ALL components
2899 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2902 C******************************************************************************
2905 C--------------------------------------------------------------------------
2906 subroutine edis(ehpb)
2908 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2910 implicit real*8 (a-h,o-z)
2911 include 'DIMENSIONS'
2912 include 'DIMENSIONS.ZSCOPT'
2913 include 'COMMON.SBRIDGE'
2914 include 'COMMON.CHAIN'
2915 include 'COMMON.DERIV'
2916 include 'COMMON.VAR'
2917 include 'COMMON.INTERACT'
2920 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2921 cd print *,'link_start=',link_start,' link_end=',link_end
2922 if (link_end.eq.0) return
2923 do i=link_start,link_end
2924 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2925 C CA-CA distance used in regularization of structure.
2928 C iii and jjj point to the residues for which the distance is assigned.
2929 if (ii.gt.nres) then
2936 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2937 C distance and angle dependent SS bond potential.
2938 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2939 & iabs(itype(jjj)).eq.1) then
2940 call ssbond_ene(iii,jjj,eij)
2943 C Calculate the distance between the two points and its difference from the
2947 C Get the force constant corresponding to this distance.
2949 C Calculate the contribution to energy.
2950 ehpb=ehpb+waga*rdis*rdis
2952 C Evaluate gradient.
2955 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2956 cd & ' waga=',waga,' fac=',fac
2958 ggg(j)=fac*(c(j,jj)-c(j,ii))
2960 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2961 C If this is a SC-SC distance, we need to calculate the contributions to the
2962 C Cartesian gradient in the SC vectors (ghpbx).
2965 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2966 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2971 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2979 C--------------------------------------------------------------------------
2980 subroutine ssbond_ene(i,j,eij)
2982 C Calculate the distance and angle dependent SS-bond potential energy
2983 C using a free-energy function derived based on RHF/6-31G** ab initio
2984 C calculations of diethyl disulfide.
2986 C A. Liwo and U. Kozlowska, 11/24/03
2988 implicit real*8 (a-h,o-z)
2989 include 'DIMENSIONS'
2990 include 'DIMENSIONS.ZSCOPT'
2991 include 'COMMON.SBRIDGE'
2992 include 'COMMON.CHAIN'
2993 include 'COMMON.DERIV'
2994 include 'COMMON.LOCAL'
2995 include 'COMMON.INTERACT'
2996 include 'COMMON.VAR'
2997 include 'COMMON.IOUNITS'
2998 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2999 itypi=iabs(itype(i))
3003 dxi=dc_norm(1,nres+i)
3004 dyi=dc_norm(2,nres+i)
3005 dzi=dc_norm(3,nres+i)
3006 dsci_inv=dsc_inv(itypi)
3007 itypj=iabs(itype(j))
3008 dscj_inv=dsc_inv(itypj)
3012 dxj=dc_norm(1,nres+j)
3013 dyj=dc_norm(2,nres+j)
3014 dzj=dc_norm(3,nres+j)
3015 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3020 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3021 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3022 om12=dxi*dxj+dyi*dyj+dzi*dzj
3024 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3025 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3031 deltat12=om2-om1+2.0d0
3033 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3034 & +akct*deltad*deltat12
3035 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3036 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3037 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3038 c & " deltat12",deltat12," eij",eij
3039 ed=2*akcm*deltad+akct*deltat12
3041 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3042 eom1=-2*akth*deltat1-pom1-om2*pom2
3043 eom2= 2*akth*deltat2+pom1-om1*pom2
3046 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3049 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3050 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3051 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3052 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3055 C Calculate the components of the gradient in DC and X
3059 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3064 C--------------------------------------------------------------------------
3065 subroutine ebond(estr)
3067 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3069 implicit real*8 (a-h,o-z)
3070 include 'DIMENSIONS'
3071 include 'DIMENSIONS.ZSCOPT'
3072 include 'COMMON.LOCAL'
3073 include 'COMMON.GEO'
3074 include 'COMMON.INTERACT'
3075 include 'COMMON.DERIV'
3076 include 'COMMON.VAR'
3077 include 'COMMON.CHAIN'
3078 include 'COMMON.IOUNITS'
3079 include 'COMMON.NAMES'
3080 include 'COMMON.FFIELD'
3081 include 'COMMON.CONTROL'
3082 logical energy_dec /.false./
3083 double precision u(3),ud(3)
3086 c write (iout,*) "distchainmax",distchainmax
3088 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3089 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3091 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3092 & *dc(j,i-1)/vbld(i)
3094 if (energy_dec) write(iout,*)
3095 & "estr1",i,vbld(i),distchainmax,
3096 & gnmr1(vbld(i),-1.0d0,distchainmax)
3098 diff = vbld(i)-vbldp0
3099 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3102 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3107 estr=0.5d0*AKP*estr+estr1
3109 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3113 if (iti.ne.10 .and. iti.ne.ntyp1) then
3116 diff=vbld(i+nres)-vbldsc0(1,iti)
3117 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3118 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3119 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3121 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3125 diff=vbld(i+nres)-vbldsc0(j,iti)
3126 ud(j)=aksc(j,iti)*diff
3127 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3141 uprod2=uprod2*u(k)*u(k)
3145 usumsqder=usumsqder+ud(j)*uprod2
3147 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3148 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3149 estr=estr+uprod/usum
3151 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3159 C--------------------------------------------------------------------------
3160 subroutine ebend(etheta)
3162 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3163 C angles gamma and its derivatives in consecutive thetas and gammas.
3165 implicit real*8 (a-h,o-z)
3166 include 'DIMENSIONS'
3167 include 'DIMENSIONS.ZSCOPT'
3168 include 'COMMON.LOCAL'
3169 include 'COMMON.GEO'
3170 include 'COMMON.INTERACT'
3171 include 'COMMON.DERIV'
3172 include 'COMMON.VAR'
3173 include 'COMMON.CHAIN'
3174 include 'COMMON.IOUNITS'
3175 include 'COMMON.NAMES'
3176 include 'COMMON.FFIELD'
3177 common /calcthet/ term1,term2,termm,diffak,ratak,
3178 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3179 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3180 double precision y(2),z(2)
3182 c time11=dexp(-2*time)
3185 c write (iout,*) "nres",nres
3186 c write (*,'(a,i2)') 'EBEND ICG=',icg
3187 c write (iout,*) ithet_start,ithet_end
3188 do i=ithet_start,ithet_end
3189 if (itype(i-1).eq.ntyp1) cycle
3190 C Zero the energy function and its derivative at 0 or pi.
3191 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3193 ichir1=isign(1,itype(i-2))
3194 ichir2=isign(1,itype(i))
3195 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3196 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3197 if (itype(i-1).eq.10) then
3198 itype1=isign(10,itype(i-2))
3199 ichir11=isign(1,itype(i-2))
3200 ichir12=isign(1,itype(i-2))
3201 itype2=isign(10,itype(i))
3202 ichir21=isign(1,itype(i))
3203 ichir22=isign(1,itype(i))
3206 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3210 c call proc_proc(phii,icrc)
3211 if (icrc.eq.1) phii=150.0
3221 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3225 c call proc_proc(phii1,icrc)
3226 if (icrc.eq.1) phii1=150.0
3238 C Calculate the "mean" value of theta from the part of the distribution
3239 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3240 C In following comments this theta will be referred to as t_c.
3241 thet_pred_mean=0.0d0
3243 athetk=athet(k,it,ichir1,ichir2)
3244 bthetk=bthet(k,it,ichir1,ichir2)
3246 athetk=athet(k,itype1,ichir11,ichir12)
3247 bthetk=bthet(k,itype2,ichir21,ichir22)
3249 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3251 c write (iout,*) "thet_pred_mean",thet_pred_mean
3252 dthett=thet_pred_mean*ssd
3253 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3254 c write (iout,*) "thet_pred_mean",thet_pred_mean
3255 C Derivatives of the "mean" values in gamma1 and gamma2.
3256 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3257 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3258 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3259 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3261 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3262 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3263 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3264 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3266 if (theta(i).gt.pi-delta) then
3267 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3269 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3270 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3271 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3273 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3275 else if (theta(i).lt.delta) then
3276 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3277 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3278 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3280 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3281 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3284 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3287 etheta=etheta+ethetai
3288 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3289 c & rad2deg*phii,rad2deg*phii1,ethetai
3290 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3291 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3292 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3295 C Ufff.... We've done all this!!!
3298 C---------------------------------------------------------------------------
3299 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3301 implicit real*8 (a-h,o-z)
3302 include 'DIMENSIONS'
3303 include 'COMMON.LOCAL'
3304 include 'COMMON.IOUNITS'
3305 common /calcthet/ term1,term2,termm,diffak,ratak,
3306 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3307 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3308 C Calculate the contributions to both Gaussian lobes.
3309 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3310 C The "polynomial part" of the "standard deviation" of this part of
3314 sig=sig*thet_pred_mean+polthet(j,it)
3316 C Derivative of the "interior part" of the "standard deviation of the"
3317 C gamma-dependent Gaussian lobe in t_c.
3318 sigtc=3*polthet(3,it)
3320 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3323 C Set the parameters of both Gaussian lobes of the distribution.
3324 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3325 fac=sig*sig+sigc0(it)
3328 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3329 sigsqtc=-4.0D0*sigcsq*sigtc
3330 c print *,i,sig,sigtc,sigsqtc
3331 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3332 sigtc=-sigtc/(fac*fac)
3333 C Following variable is sigma(t_c)**(-2)
3334 sigcsq=sigcsq*sigcsq
3336 sig0inv=1.0D0/sig0i**2
3337 delthec=thetai-thet_pred_mean
3338 delthe0=thetai-theta0i
3339 term1=-0.5D0*sigcsq*delthec*delthec
3340 term2=-0.5D0*sig0inv*delthe0*delthe0
3341 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3342 C NaNs in taking the logarithm. We extract the largest exponent which is added
3343 C to the energy (this being the log of the distribution) at the end of energy
3344 C term evaluation for this virtual-bond angle.
3345 if (term1.gt.term2) then
3347 term2=dexp(term2-termm)
3351 term1=dexp(term1-termm)
3354 C The ratio between the gamma-independent and gamma-dependent lobes of
3355 C the distribution is a Gaussian function of thet_pred_mean too.
3356 diffak=gthet(2,it)-thet_pred_mean
3357 ratak=diffak/gthet(3,it)**2
3358 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3359 C Let's differentiate it in thet_pred_mean NOW.
3361 C Now put together the distribution terms to make complete distribution.
3362 termexp=term1+ak*term2
3363 termpre=sigc+ak*sig0i
3364 C Contribution of the bending energy from this theta is just the -log of
3365 C the sum of the contributions from the two lobes and the pre-exponential
3366 C factor. Simple enough, isn't it?
3367 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3368 C NOW the derivatives!!!
3369 C 6/6/97 Take into account the deformation.
3370 E_theta=(delthec*sigcsq*term1
3371 & +ak*delthe0*sig0inv*term2)/termexp
3372 E_tc=((sigtc+aktc*sig0i)/termpre
3373 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3374 & aktc*term2)/termexp)
3377 c-----------------------------------------------------------------------------
3378 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3379 implicit real*8 (a-h,o-z)
3380 include 'DIMENSIONS'
3381 include 'COMMON.LOCAL'
3382 include 'COMMON.IOUNITS'
3383 common /calcthet/ term1,term2,termm,diffak,ratak,
3384 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3385 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3386 delthec=thetai-thet_pred_mean
3387 delthe0=thetai-theta0i
3388 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3389 t3 = thetai-thet_pred_mean
3393 t14 = t12+t6*sigsqtc
3395 t21 = thetai-theta0i
3401 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3402 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3403 & *(-t12*t9-ak*sig0inv*t27)
3407 C--------------------------------------------------------------------------
3408 subroutine ebend(etheta)
3410 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3411 C angles gamma and its derivatives in consecutive thetas and gammas.
3412 C ab initio-derived potentials from
3413 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3415 implicit real*8 (a-h,o-z)
3416 include 'DIMENSIONS'
3417 include 'DIMENSIONS.ZSCOPT'
3418 include 'COMMON.LOCAL'
3419 include 'COMMON.GEO'
3420 include 'COMMON.INTERACT'
3421 include 'COMMON.DERIV'
3422 include 'COMMON.VAR'
3423 include 'COMMON.CHAIN'
3424 include 'COMMON.IOUNITS'
3425 include 'COMMON.NAMES'
3426 include 'COMMON.FFIELD'
3427 include 'COMMON.CONTROL'
3428 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3429 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3430 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3431 & sinph1ph2(maxdouble,maxdouble)
3432 logical lprn /.false./, lprn1 /.false./
3434 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3435 do i=ithet_start,ithet_end
3436 c if (itype(i-1).eq.ntyp1) cycle
3437 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3438 &(itype(i).eq.ntyp1)) cycle
3439 if (iabs(itype(i+1)).eq.20) iblock=2
3440 if (iabs(itype(i+1)).ne.20) iblock=1
3444 theti2=0.5d0*theta(i)
3445 ityp2=ithetyp((itype(i-1)))
3447 coskt(k)=dcos(k*theti2)
3448 sinkt(k)=dsin(k*theti2)
3450 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3453 if (phii.ne.phii) phii=150.0
3457 ityp1=ithetyp((itype(i-2)))
3459 cosph1(k)=dcos(k*phii)
3460 sinph1(k)=dsin(k*phii)
3466 ityp1=ithetyp((itype(i-2)))
3471 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3474 if (phii1.ne.phii1) phii1=150.0
3479 ityp3=ithetyp((itype(i)))
3481 cosph2(k)=dcos(k*phii1)
3482 sinph2(k)=dsin(k*phii1)
3487 ityp3=ithetyp((itype(i)))
3493 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3494 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3496 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3499 ccl=cosph1(l)*cosph2(k-l)
3500 ssl=sinph1(l)*sinph2(k-l)
3501 scl=sinph1(l)*cosph2(k-l)
3502 csl=cosph1(l)*sinph2(k-l)
3503 cosph1ph2(l,k)=ccl-ssl
3504 cosph1ph2(k,l)=ccl+ssl
3505 sinph1ph2(l,k)=scl+csl
3506 sinph1ph2(k,l)=scl-csl
3510 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3511 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3512 write (iout,*) "coskt and sinkt"
3514 write (iout,*) k,coskt(k),sinkt(k)
3518 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3519 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3522 & write (iout,*) "k",k,"
3523 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3524 & " ethetai",ethetai
3527 write (iout,*) "cosph and sinph"
3529 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3531 write (iout,*) "cosph1ph2 and sinph2ph2"
3534 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3535 & sinph1ph2(l,k),sinph1ph2(k,l)
3538 write(iout,*) "ethetai",ethetai
3542 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3543 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3544 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3545 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3546 ethetai=ethetai+sinkt(m)*aux
3547 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3548 dephii=dephii+k*sinkt(m)*(
3549 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3550 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3551 dephii1=dephii1+k*sinkt(m)*(
3552 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3553 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3555 & write (iout,*) "m",m," k",k," bbthet",
3556 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3557 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3558 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3559 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3563 & write(iout,*) "ethetai",ethetai
3567 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3568 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3569 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3570 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3571 ethetai=ethetai+sinkt(m)*aux
3572 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3573 dephii=dephii+l*sinkt(m)*(
3574 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3575 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3576 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3577 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3578 dephii1=dephii1+(k-l)*sinkt(m)*(
3579 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3580 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3581 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3582 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3584 write (iout,*) "m",m," k",k," l",l," ffthet",
3585 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3586 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3587 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3588 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3589 & " ethetai",ethetai
3590 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3591 & cosph1ph2(k,l)*sinkt(m),
3592 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3598 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3599 & i,theta(i)*rad2deg,phii*rad2deg,
3600 & phii1*rad2deg,ethetai
3601 etheta=etheta+ethetai
3602 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3603 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3604 c gloc(nphi+i-2,icg)=wang*dethetai
3605 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3611 c-----------------------------------------------------------------------------
3612 subroutine esc(escloc)
3613 C Calculate the local energy of a side chain and its derivatives in the
3614 C corresponding virtual-bond valence angles THETA and the spherical angles
3616 implicit real*8 (a-h,o-z)
3617 include 'DIMENSIONS'
3618 include 'DIMENSIONS.ZSCOPT'
3619 include 'COMMON.GEO'
3620 include 'COMMON.LOCAL'
3621 include 'COMMON.VAR'
3622 include 'COMMON.INTERACT'
3623 include 'COMMON.DERIV'
3624 include 'COMMON.CHAIN'
3625 include 'COMMON.IOUNITS'
3626 include 'COMMON.NAMES'
3627 include 'COMMON.FFIELD'
3628 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3629 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3630 common /sccalc/ time11,time12,time112,theti,it,nlobit
3633 c write (iout,'(a)') 'ESC'
3634 do i=loc_start,loc_end
3636 if (it.eq.ntyp1) cycle
3637 if (it.eq.10) goto 1
3638 nlobit=nlob(iabs(it))
3639 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3640 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3641 theti=theta(i+1)-pipol
3645 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3647 if (x(2).gt.pi-delta) then
3651 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3653 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3654 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3656 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3657 & ddersc0(1),dersc(1))
3658 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3659 & ddersc0(3),dersc(3))
3661 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3663 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3664 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3665 & dersc0(2),esclocbi,dersc02)
3666 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3668 call splinthet(x(2),0.5d0*delta,ss,ssd)
3673 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3675 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3676 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3678 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3680 c write (iout,*) escloci
3681 else if (x(2).lt.delta) then
3685 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3687 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3688 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3690 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3691 & ddersc0(1),dersc(1))
3692 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3693 & ddersc0(3),dersc(3))
3695 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3697 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3698 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3699 & dersc0(2),esclocbi,dersc02)
3700 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3705 call splinthet(x(2),0.5d0*delta,ss,ssd)
3707 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3709 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3710 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3712 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3713 c write (iout,*) escloci
3715 call enesc(x,escloci,dersc,ddummy,.false.)
3718 escloc=escloc+escloci
3719 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3721 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3723 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3724 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3729 C---------------------------------------------------------------------------
3730 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3731 implicit real*8 (a-h,o-z)
3732 include 'DIMENSIONS'
3733 include 'COMMON.GEO'
3734 include 'COMMON.LOCAL'
3735 include 'COMMON.IOUNITS'
3736 common /sccalc/ time11,time12,time112,theti,it,nlobit
3737 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3738 double precision contr(maxlob,-1:1)
3740 c write (iout,*) 'it=',it,' nlobit=',nlobit
3744 if (mixed) ddersc(j)=0.0d0
3748 C Because of periodicity of the dependence of the SC energy in omega we have
3749 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3750 C To avoid underflows, first compute & store the exponents.
3758 z(k)=x(k)-censc(k,j,it)
3763 Axk=Axk+gaussc(l,k,j,it)*z(l)
3769 expfac=expfac+Ax(k,j,iii)*z(k)
3777 C As in the case of ebend, we want to avoid underflows in exponentiation and
3778 C subsequent NaNs and INFs in energy calculation.
3779 C Find the largest exponent
3783 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3787 cd print *,'it=',it,' emin=',emin
3789 C Compute the contribution to SC energy and derivatives
3793 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3794 cd print *,'j=',j,' expfac=',expfac
3795 escloc_i=escloc_i+expfac
3797 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3801 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3802 & +gaussc(k,2,j,it))*expfac
3809 dersc(1)=dersc(1)/cos(theti)**2
3810 ddersc(1)=ddersc(1)/cos(theti)**2
3813 escloci=-(dlog(escloc_i)-emin)
3815 dersc(j)=dersc(j)/escloc_i
3819 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3824 C------------------------------------------------------------------------------
3825 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3826 implicit real*8 (a-h,o-z)
3827 include 'DIMENSIONS'
3828 include 'COMMON.GEO'
3829 include 'COMMON.LOCAL'
3830 include 'COMMON.IOUNITS'
3831 common /sccalc/ time11,time12,time112,theti,it,nlobit
3832 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3833 double precision contr(maxlob)
3844 z(k)=x(k)-censc(k,j,it)
3850 Axk=Axk+gaussc(l,k,j,it)*z(l)
3856 expfac=expfac+Ax(k,j)*z(k)
3861 C As in the case of ebend, we want to avoid underflows in exponentiation and
3862 C subsequent NaNs and INFs in energy calculation.
3863 C Find the largest exponent
3866 if (emin.gt.contr(j)) emin=contr(j)
3870 C Compute the contribution to SC energy and derivatives
3874 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3875 escloc_i=escloc_i+expfac
3877 dersc(k)=dersc(k)+Ax(k,j)*expfac
3879 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3880 & +gaussc(1,2,j,it))*expfac
3884 dersc(1)=dersc(1)/cos(theti)**2
3885 dersc12=dersc12/cos(theti)**2
3886 escloci=-(dlog(escloc_i)-emin)
3888 dersc(j)=dersc(j)/escloc_i
3890 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3894 c----------------------------------------------------------------------------------
3895 subroutine esc(escloc)
3896 C Calculate the local energy of a side chain and its derivatives in the
3897 C corresponding virtual-bond valence angles THETA and the spherical angles
3898 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3899 C added by Urszula Kozlowska. 07/11/2007
3901 implicit real*8 (a-h,o-z)
3902 include 'DIMENSIONS'
3903 include 'DIMENSIONS.ZSCOPT'
3904 include 'COMMON.GEO'
3905 include 'COMMON.LOCAL'
3906 include 'COMMON.VAR'
3907 include 'COMMON.SCROT'
3908 include 'COMMON.INTERACT'
3909 include 'COMMON.DERIV'
3910 include 'COMMON.CHAIN'
3911 include 'COMMON.IOUNITS'
3912 include 'COMMON.NAMES'
3913 include 'COMMON.FFIELD'
3914 include 'COMMON.CONTROL'
3915 include 'COMMON.VECTORS'
3916 double precision x_prime(3),y_prime(3),z_prime(3)
3917 & , sumene,dsc_i,dp2_i,x(65),
3918 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3919 & de_dxx,de_dyy,de_dzz,de_dt
3920 double precision s1_t,s1_6_t,s2_t,s2_6_t
3922 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3923 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3924 & dt_dCi(3),dt_dCi1(3)
3925 common /sccalc/ time11,time12,time112,theti,it,nlobit
3928 do i=loc_start,loc_end
3929 if (itype(i).eq.ntyp1) cycle
3930 costtab(i+1) =dcos(theta(i+1))
3931 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3932 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3933 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3934 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3935 cosfac=dsqrt(cosfac2)
3936 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3937 sinfac=dsqrt(sinfac2)
3939 if (it.eq.10) goto 1
3941 C Compute the axes of tghe local cartesian coordinates system; store in
3942 c x_prime, y_prime and z_prime
3949 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3950 C & dc_norm(3,i+nres)
3952 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3953 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3956 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
3959 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3960 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3961 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3962 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3963 c & " xy",scalar(x_prime(1),y_prime(1)),
3964 c & " xz",scalar(x_prime(1),z_prime(1)),
3965 c & " yy",scalar(y_prime(1),y_prime(1)),
3966 c & " yz",scalar(y_prime(1),z_prime(1)),
3967 c & " zz",scalar(z_prime(1),z_prime(1))
3969 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3970 C to local coordinate system. Store in xx, yy, zz.
3976 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3977 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3978 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3985 C Compute the energy of the ith side cbain
3987 c write (2,*) "xx",xx," yy",yy," zz",zz
3990 x(j) = sc_parmin(j,it)
3993 Cc diagnostics - remove later
3995 yy1 = dsin(alph(2))*dcos(omeg(2))
3996 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
3997 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3998 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4000 C," --- ", xx_w,yy_w,zz_w
4003 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4004 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4006 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4007 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4009 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4010 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4011 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4012 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4013 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4015 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4016 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4017 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4018 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4019 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4021 dsc_i = 0.743d0+x(61)
4023 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4024 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4025 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4026 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4027 s1=(1+x(63))/(0.1d0 + dscp1)
4028 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4029 s2=(1+x(65))/(0.1d0 + dscp2)
4030 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4031 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4032 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4033 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4035 c & dscp1,dscp2,sumene
4036 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4037 escloc = escloc + sumene
4038 c write (2,*) "escloc",escloc
4039 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4041 if (.not. calc_grad) goto 1
4044 C This section to check the numerical derivatives of the energy of ith side
4045 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4046 C #define DEBUG in the code to turn it on.
4048 write (2,*) "sumene =",sumene
4052 write (2,*) xx,yy,zz
4053 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4054 de_dxx_num=(sumenep-sumene)/aincr
4056 write (2,*) "xx+ sumene from enesc=",sumenep
4059 write (2,*) xx,yy,zz
4060 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4061 de_dyy_num=(sumenep-sumene)/aincr
4063 write (2,*) "yy+ sumene from enesc=",sumenep
4066 write (2,*) xx,yy,zz
4067 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4068 de_dzz_num=(sumenep-sumene)/aincr
4070 write (2,*) "zz+ sumene from enesc=",sumenep
4071 costsave=cost2tab(i+1)
4072 sintsave=sint2tab(i+1)
4073 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4074 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4075 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4076 de_dt_num=(sumenep-sumene)/aincr
4077 write (2,*) " t+ sumene from enesc=",sumenep
4078 cost2tab(i+1)=costsave
4079 sint2tab(i+1)=sintsave
4080 C End of diagnostics section.
4083 C Compute the gradient of esc
4085 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4086 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4087 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4088 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4089 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4090 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4091 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4092 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4093 pom1=(sumene3*sint2tab(i+1)+sumene1)
4094 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4095 pom2=(sumene4*cost2tab(i+1)+sumene2)
4096 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4097 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4098 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4099 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4101 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4102 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4103 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4105 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4106 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4107 & +(pom1+pom2)*pom_dx
4109 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4112 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4113 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4114 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4116 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4117 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4118 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4119 & +x(59)*zz**2 +x(60)*xx*zz
4120 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4121 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4122 & +(pom1-pom2)*pom_dy
4124 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4127 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4128 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4129 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4130 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4131 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4132 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4133 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4134 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4136 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4139 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4140 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4141 & +pom1*pom_dt1+pom2*pom_dt2
4143 write(2,*), "de_dt = ", de_dt,de_dt_num
4147 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4148 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4149 cosfac2xx=cosfac2*xx
4150 sinfac2yy=sinfac2*yy
4152 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4154 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4156 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4157 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4158 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4159 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4160 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4161 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4162 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4163 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4164 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4165 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4169 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4170 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4171 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4172 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4175 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4176 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4177 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4179 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4180 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4184 dXX_Ctab(k,i)=dXX_Ci(k)
4185 dXX_C1tab(k,i)=dXX_Ci1(k)
4186 dYY_Ctab(k,i)=dYY_Ci(k)
4187 dYY_C1tab(k,i)=dYY_Ci1(k)
4188 dZZ_Ctab(k,i)=dZZ_Ci(k)
4189 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4190 dXX_XYZtab(k,i)=dXX_XYZ(k)
4191 dYY_XYZtab(k,i)=dYY_XYZ(k)
4192 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4196 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4197 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4198 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4199 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4200 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4202 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4203 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4204 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4205 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4206 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4207 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4208 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4209 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4211 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4212 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4214 C to check gradient call subroutine check_grad
4221 c------------------------------------------------------------------------------
4222 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4224 C This procedure calculates two-body contact function g(rij) and its derivative:
4227 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4230 C where x=(rij-r0ij)/delta
4232 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4235 double precision rij,r0ij,eps0ij,fcont,fprimcont
4236 double precision x,x2,x4,delta
4240 if (x.lt.-1.0D0) then
4243 else if (x.le.1.0D0) then
4246 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4247 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4254 c------------------------------------------------------------------------------
4255 subroutine splinthet(theti,delta,ss,ssder)
4256 implicit real*8 (a-h,o-z)
4257 include 'DIMENSIONS'
4258 include 'DIMENSIONS.ZSCOPT'
4259 include 'COMMON.VAR'
4260 include 'COMMON.GEO'
4263 if (theti.gt.pipol) then
4264 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4266 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4271 c------------------------------------------------------------------------------
4272 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4274 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4275 double precision ksi,ksi2,ksi3,a1,a2,a3
4276 a1=fprim0*delta/(f1-f0)
4282 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4283 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4286 c------------------------------------------------------------------------------
4287 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4289 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4290 double precision ksi,ksi2,ksi3,a1,a2,a3
4295 a2=3*(f1x-f0x)-2*fprim0x*delta
4296 a3=fprim0x*delta-2*(f1x-f0x)
4297 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4300 C-----------------------------------------------------------------------------
4302 C-----------------------------------------------------------------------------
4303 subroutine etor(etors,edihcnstr,fact)
4304 implicit real*8 (a-h,o-z)
4305 include 'DIMENSIONS'
4306 include 'DIMENSIONS.ZSCOPT'
4307 include 'COMMON.VAR'
4308 include 'COMMON.GEO'
4309 include 'COMMON.LOCAL'
4310 include 'COMMON.TORSION'
4311 include 'COMMON.INTERACT'
4312 include 'COMMON.DERIV'
4313 include 'COMMON.CHAIN'
4314 include 'COMMON.NAMES'
4315 include 'COMMON.IOUNITS'
4316 include 'COMMON.FFIELD'
4317 include 'COMMON.TORCNSTR'
4319 C Set lprn=.true. for debugging
4323 do i=iphi_start,iphi_end
4324 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4325 & .or. itype(i).eq.ntyp1) cycle
4326 itori=itortyp(itype(i-2))
4327 itori1=itortyp(itype(i-1))
4330 C Proline-Proline pair is a special case...
4331 if (itori.eq.3 .and. itori1.eq.3) then
4332 if (phii.gt.-dwapi3) then
4334 fac=1.0D0/(1.0D0-cosphi)
4335 etorsi=v1(1,3,3)*fac
4336 etorsi=etorsi+etorsi
4337 etors=etors+etorsi-v1(1,3,3)
4338 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4341 v1ij=v1(j+1,itori,itori1)
4342 v2ij=v2(j+1,itori,itori1)
4345 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4346 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4350 v1ij=v1(j,itori,itori1)
4351 v2ij=v2(j,itori,itori1)
4354 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4355 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4359 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4360 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4361 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4362 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4363 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4365 ! 6/20/98 - dihedral angle constraints
4368 itori=idih_constr(i)
4371 if (difi.gt.drange(i)) then
4373 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4374 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4375 else if (difi.lt.-drange(i)) then
4377 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4378 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4380 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4381 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4383 ! write (iout,*) 'edihcnstr',edihcnstr
4386 c------------------------------------------------------------------------------
4388 subroutine etor(etors,edihcnstr,fact)
4389 implicit real*8 (a-h,o-z)
4390 include 'DIMENSIONS'
4391 include 'DIMENSIONS.ZSCOPT'
4392 include 'COMMON.VAR'
4393 include 'COMMON.GEO'
4394 include 'COMMON.LOCAL'
4395 include 'COMMON.TORSION'
4396 include 'COMMON.INTERACT'
4397 include 'COMMON.DERIV'
4398 include 'COMMON.CHAIN'
4399 include 'COMMON.NAMES'
4400 include 'COMMON.IOUNITS'
4401 include 'COMMON.FFIELD'
4402 include 'COMMON.TORCNSTR'
4404 C Set lprn=.true. for debugging
4408 do i=iphi_start,iphi_end
4409 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4410 & .or. itype(i).eq.ntyp1) cycle
4411 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4412 if (iabs(itype(i)).eq.20) then
4417 itori=itortyp(itype(i-2))
4418 itori1=itortyp(itype(i-1))
4421 C Regular cosine and sine terms
4422 do j=1,nterm(itori,itori1,iblock)
4423 v1ij=v1(j,itori,itori1,iblock)
4424 v2ij=v2(j,itori,itori1,iblock)
4427 etors=etors+v1ij*cosphi+v2ij*sinphi
4428 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4432 C E = SUM ----------------------------------- - v1
4433 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4435 cosphi=dcos(0.5d0*phii)
4436 sinphi=dsin(0.5d0*phii)
4437 do j=1,nlor(itori,itori1,iblock)
4438 vl1ij=vlor1(j,itori,itori1)
4439 vl2ij=vlor2(j,itori,itori1)
4440 vl3ij=vlor3(j,itori,itori1)
4441 pom=vl2ij*cosphi+vl3ij*sinphi
4442 pom1=1.0d0/(pom*pom+1.0d0)
4443 etors=etors+vl1ij*pom1
4444 c if (energy_dec) etors_ii=etors_ii+
4447 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4449 C Subtract the constant term
4450 etors=etors-v0(itori,itori1,iblock)
4452 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4453 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4454 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4455 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4456 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4459 ! 6/20/98 - dihedral angle constraints
4462 itori=idih_constr(i)
4464 difi=pinorm(phii-phi0(i))
4466 if (difi.gt.drange(i)) then
4468 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4469 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4470 edihi=0.25d0*ftors*difi**4
4471 else if (difi.lt.-drange(i)) then
4473 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4474 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4475 edihi=0.25d0*ftors*difi**4
4479 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4481 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4482 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4484 ! write (iout,*) 'edihcnstr',edihcnstr
4487 c----------------------------------------------------------------------------
4488 subroutine etor_d(etors_d,fact2)
4489 C 6/23/01 Compute double torsional energy
4490 implicit real*8 (a-h,o-z)
4491 include 'DIMENSIONS'
4492 include 'DIMENSIONS.ZSCOPT'
4493 include 'COMMON.VAR'
4494 include 'COMMON.GEO'
4495 include 'COMMON.LOCAL'
4496 include 'COMMON.TORSION'
4497 include 'COMMON.INTERACT'
4498 include 'COMMON.DERIV'
4499 include 'COMMON.CHAIN'
4500 include 'COMMON.NAMES'
4501 include 'COMMON.IOUNITS'
4502 include 'COMMON.FFIELD'
4503 include 'COMMON.TORCNSTR'
4505 C Set lprn=.true. for debugging
4509 do i=iphi_start,iphi_end-1
4510 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4511 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4512 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4514 itori=itortyp(itype(i-2))
4515 itori1=itortyp(itype(i-1))
4516 itori2=itortyp(itype(i))
4522 if (iabs(itype(i+1)).eq.20) iblock=2
4523 C Regular cosine and sine terms
4524 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4525 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4526 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4527 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4528 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4529 cosphi1=dcos(j*phii)
4530 sinphi1=dsin(j*phii)
4531 cosphi2=dcos(j*phii1)
4532 sinphi2=dsin(j*phii1)
4533 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4534 & v2cij*cosphi2+v2sij*sinphi2
4535 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4536 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4538 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4540 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4541 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4542 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4543 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4544 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4545 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4546 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4547 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4548 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4549 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4550 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4551 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4552 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4553 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4556 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4557 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4563 c------------------------------------------------------------------------------
4564 subroutine eback_sc_corr(esccor)
4565 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4566 c conformational states; temporarily implemented as differences
4567 c between UNRES torsional potentials (dependent on three types of
4568 c residues) and the torsional potentials dependent on all 20 types
4569 c of residues computed from AM1 energy surfaces of terminally-blocked
4570 c amino-acid residues.
4571 implicit real*8 (a-h,o-z)
4572 include 'DIMENSIONS'
4573 include 'DIMENSIONS.ZSCOPT'
4574 include 'COMMON.VAR'
4575 include 'COMMON.GEO'
4576 include 'COMMON.LOCAL'
4577 include 'COMMON.TORSION'
4578 include 'COMMON.SCCOR'
4579 include 'COMMON.INTERACT'
4580 include 'COMMON.DERIV'
4581 include 'COMMON.CHAIN'
4582 include 'COMMON.NAMES'
4583 include 'COMMON.IOUNITS'
4584 include 'COMMON.FFIELD'
4585 include 'COMMON.CONTROL'
4587 C Set lprn=.true. for debugging
4590 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4592 do i=itau_start,itau_end
4593 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4595 isccori=isccortyp(itype(i-2))
4596 isccori1=isccortyp(itype(i-1))
4598 do intertyp=1,3 !intertyp
4599 cc Added 09 May 2012 (Adasko)
4600 cc Intertyp means interaction type of backbone mainchain correlation:
4601 c 1 = SC...Ca...Ca...Ca
4602 c 2 = Ca...Ca...Ca...SC
4603 c 3 = SC...Ca...Ca...SCi
4605 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4606 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4607 & (itype(i-1).eq.ntyp1)))
4608 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4609 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4610 & .or.(itype(i).eq.ntyp1)))
4611 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4612 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4613 & (itype(i-3).eq.ntyp1)))) cycle
4614 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4615 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4617 do j=1,nterm_sccor(isccori,isccori1)
4618 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4619 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4620 cosphi=dcos(j*tauangle(intertyp,i))
4621 sinphi=dsin(j*tauangle(intertyp,i))
4622 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4623 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4625 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4626 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4627 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4629 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4630 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4631 & (v1sccor(j,1,itori,itori1),j=1,6)
4632 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4633 c gsccor_loc(i-3)=gloci
4638 c------------------------------------------------------------------------------
4639 subroutine multibody(ecorr)
4640 C This subroutine calculates multi-body contributions to energy following
4641 C the idea of Skolnick et al. If side chains I and J make a contact and
4642 C at the same time side chains I+1 and J+1 make a contact, an extra
4643 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4644 implicit real*8 (a-h,o-z)
4645 include 'DIMENSIONS'
4646 include 'COMMON.IOUNITS'
4647 include 'COMMON.DERIV'
4648 include 'COMMON.INTERACT'
4649 include 'COMMON.CONTACTS'
4650 double precision gx(3),gx1(3)
4653 C Set lprn=.true. for debugging
4657 write (iout,'(a)') 'Contact function values:'
4659 write (iout,'(i2,20(1x,i2,f10.5))')
4660 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4675 num_conti=num_cont(i)
4676 num_conti1=num_cont(i1)
4681 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4682 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4683 cd & ' ishift=',ishift
4684 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4685 C The system gains extra energy.
4686 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4687 endif ! j1==j+-ishift
4696 c------------------------------------------------------------------------------
4697 double precision function esccorr(i,j,k,l,jj,kk)
4698 implicit real*8 (a-h,o-z)
4699 include 'DIMENSIONS'
4700 include 'COMMON.IOUNITS'
4701 include 'COMMON.DERIV'
4702 include 'COMMON.INTERACT'
4703 include 'COMMON.CONTACTS'
4704 double precision gx(3),gx1(3)
4709 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4710 C Calculate the multi-body contribution to energy.
4711 C Calculate multi-body contributions to the gradient.
4712 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4713 cd & k,l,(gacont(m,kk,k),m=1,3)
4715 gx(m) =ekl*gacont(m,jj,i)
4716 gx1(m)=eij*gacont(m,kk,k)
4717 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4718 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4719 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4720 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4724 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4729 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4735 c------------------------------------------------------------------------------
4737 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4738 implicit real*8 (a-h,o-z)
4739 include 'DIMENSIONS'
4740 integer dimen1,dimen2,atom,indx
4741 double precision buffer(dimen1,dimen2)
4742 double precision zapas
4743 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4744 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
4745 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4746 num_kont=num_cont_hb(atom)
4750 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4753 buffer(i,indx+22)=facont_hb(i,atom)
4754 buffer(i,indx+23)=ees0p(i,atom)
4755 buffer(i,indx+24)=ees0m(i,atom)
4756 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4758 buffer(1,indx+26)=dfloat(num_kont)
4761 c------------------------------------------------------------------------------
4762 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4763 implicit real*8 (a-h,o-z)
4764 include 'DIMENSIONS'
4765 integer dimen1,dimen2,atom,indx
4766 double precision buffer(dimen1,dimen2)
4767 double precision zapas
4768 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4769 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
4770 & ees0m(ntyp,maxres),
4771 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4772 num_kont=buffer(1,indx+26)
4773 num_kont_old=num_cont_hb(atom)
4774 num_cont_hb(atom)=num_kont+num_kont_old
4779 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4782 facont_hb(ii,atom)=buffer(i,indx+22)
4783 ees0p(ii,atom)=buffer(i,indx+23)
4784 ees0m(ii,atom)=buffer(i,indx+24)
4785 jcont_hb(ii,atom)=buffer(i,indx+25)
4789 c------------------------------------------------------------------------------
4791 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4792 C This subroutine calculates multi-body contributions to hydrogen-bonding
4793 implicit real*8 (a-h,o-z)
4794 include 'DIMENSIONS'
4795 include 'DIMENSIONS.ZSCOPT'
4796 include 'COMMON.IOUNITS'
4798 include 'COMMON.INFO'
4800 include 'COMMON.FFIELD'
4801 include 'COMMON.DERIV'
4802 include 'COMMON.INTERACT'
4803 include 'COMMON.CONTACTS'
4805 parameter (max_cont=maxconts)
4806 parameter (max_dim=2*(8*3+2))
4807 parameter (msglen1=max_cont*max_dim*4)
4808 parameter (msglen2=2*msglen1)
4809 integer source,CorrelType,CorrelID,Error
4810 double precision buffer(max_cont,max_dim)
4812 double precision gx(3),gx1(3)
4815 C Set lprn=.true. for debugging
4820 if (fgProcs.le.1) goto 30
4822 write (iout,'(a)') 'Contact function values:'
4824 write (iout,'(2i3,50(1x,i2,f5.2))')
4825 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4826 & j=1,num_cont_hb(i))
4829 C Caution! Following code assumes that electrostatic interactions concerning
4830 C a given atom are split among at most two processors!
4840 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4843 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4844 if (MyRank.gt.0) then
4845 C Send correlation contributions to the preceding processor
4847 nn=num_cont_hb(iatel_s)
4848 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4849 cd write (iout,*) 'The BUFFER array:'
4851 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4853 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4855 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4856 C Clear the contacts of the atom passed to the neighboring processor
4857 nn=num_cont_hb(iatel_s+1)
4859 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4861 num_cont_hb(iatel_s)=0
4863 cd write (iout,*) 'Processor ',MyID,MyRank,
4864 cd & ' is sending correlation contribution to processor',MyID-1,
4865 cd & ' msglen=',msglen
4866 cd write (*,*) 'Processor ',MyID,MyRank,
4867 cd & ' is sending correlation contribution to processor',MyID-1,
4868 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4869 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4870 cd write (iout,*) 'Processor ',MyID,
4871 cd & ' has sent correlation contribution to processor',MyID-1,
4872 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4873 cd write (*,*) 'Processor ',MyID,
4874 cd & ' has sent correlation contribution to processor',MyID-1,
4875 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4877 endif ! (MyRank.gt.0)
4881 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4882 if (MyRank.lt.fgProcs-1) then
4883 C Receive correlation contributions from the next processor
4885 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4886 cd write (iout,*) 'Processor',MyID,
4887 cd & ' is receiving correlation contribution from processor',MyID+1,
4888 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4889 cd write (*,*) 'Processor',MyID,
4890 cd & ' is receiving correlation contribution from processor',MyID+1,
4891 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4893 do while (nbytes.le.0)
4894 call mp_probe(MyID+1,CorrelType,nbytes)
4896 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4897 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4898 cd write (iout,*) 'Processor',MyID,
4899 cd & ' has received correlation contribution from processor',MyID+1,
4900 cd & ' msglen=',msglen,' nbytes=',nbytes
4901 cd write (iout,*) 'The received BUFFER array:'
4903 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4905 if (msglen.eq.msglen1) then
4906 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4907 else if (msglen.eq.msglen2) then
4908 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4909 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4912 & 'ERROR!!!! message length changed while processing correlations.'
4914 & 'ERROR!!!! message length changed while processing correlations.'
4915 call mp_stopall(Error)
4916 endif ! msglen.eq.msglen1
4917 endif ! MyRank.lt.fgProcs-1
4924 write (iout,'(a)') 'Contact function values:'
4926 write (iout,'(2i3,50(1x,i2,f5.2))')
4927 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4928 & j=1,num_cont_hb(i))
4932 C Remove the loop below after debugging !!!
4939 C Calculate the local-electrostatic correlation terms
4940 do i=iatel_s,iatel_e+1
4942 num_conti=num_cont_hb(i)
4943 num_conti1=num_cont_hb(i+1)
4948 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4949 c & ' jj=',jj,' kk=',kk
4950 if (j1.eq.j+1 .or. j1.eq.j-1) then
4951 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4952 C The system gains extra energy.
4953 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4955 else if (j1.eq.j) then
4956 C Contacts I-J and I-(J+1) occur simultaneously.
4957 C The system loses extra energy.
4958 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4963 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4964 c & ' jj=',jj,' kk=',kk
4966 C Contacts I-J and (I+1)-J occur simultaneously.
4967 C The system loses extra energy.
4968 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4975 c------------------------------------------------------------------------------
4976 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4978 C This subroutine calculates multi-body contributions to hydrogen-bonding
4979 implicit real*8 (a-h,o-z)
4980 include 'DIMENSIONS'
4981 include 'DIMENSIONS.ZSCOPT'
4982 include 'COMMON.IOUNITS'
4984 include 'COMMON.INFO'
4986 include 'COMMON.FFIELD'
4987 include 'COMMON.DERIV'
4988 include 'COMMON.INTERACT'
4989 include 'COMMON.CONTACTS'
4991 parameter (max_cont=maxconts)
4992 parameter (max_dim=2*(8*3+2))
4993 parameter (msglen1=max_cont*max_dim*4)
4994 parameter (msglen2=2*msglen1)
4995 integer source,CorrelType,CorrelID,Error
4996 double precision buffer(max_cont,max_dim)
4998 double precision gx(3),gx1(3)
5001 C Set lprn=.true. for debugging
5007 if (fgProcs.le.1) goto 30
5009 write (iout,'(a)') 'Contact function values:'
5011 write (iout,'(2i3,50(1x,i2,f5.2))')
5012 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5013 & j=1,num_cont_hb(i))
5016 C Caution! Following code assumes that electrostatic interactions concerning
5017 C a given atom are split among at most two processors!
5027 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5030 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5031 if (MyRank.gt.0) then
5032 C Send correlation contributions to the preceding processor
5034 nn=num_cont_hb(iatel_s)
5035 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5036 cd write (iout,*) 'The BUFFER array:'
5038 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5040 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5042 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5043 C Clear the contacts of the atom passed to the neighboring processor
5044 nn=num_cont_hb(iatel_s+1)
5046 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5048 num_cont_hb(iatel_s)=0
5050 cd write (iout,*) 'Processor ',MyID,MyRank,
5051 cd & ' is sending correlation contribution to processor',MyID-1,
5052 cd & ' msglen=',msglen
5053 cd write (*,*) 'Processor ',MyID,MyRank,
5054 cd & ' is sending correlation contribution to processor',MyID-1,
5055 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5056 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5057 cd write (iout,*) 'Processor ',MyID,
5058 cd & ' has sent correlation contribution to processor',MyID-1,
5059 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5060 cd write (*,*) 'Processor ',MyID,
5061 cd & ' has sent correlation contribution to processor',MyID-1,
5062 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5064 endif ! (MyRank.gt.0)
5068 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5069 if (MyRank.lt.fgProcs-1) then
5070 C Receive correlation contributions from the next processor
5072 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5073 cd write (iout,*) 'Processor',MyID,
5074 cd & ' is receiving correlation contribution from processor',MyID+1,
5075 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5076 cd write (*,*) 'Processor',MyID,
5077 cd & ' is receiving correlation contribution from processor',MyID+1,
5078 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5080 do while (nbytes.le.0)
5081 call mp_probe(MyID+1,CorrelType,nbytes)
5083 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5084 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5085 cd write (iout,*) 'Processor',MyID,
5086 cd & ' has received correlation contribution from processor',MyID+1,
5087 cd & ' msglen=',msglen,' nbytes=',nbytes
5088 cd write (iout,*) 'The received BUFFER array:'
5090 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5092 if (msglen.eq.msglen1) then
5093 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5094 else if (msglen.eq.msglen2) then
5095 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5096 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5099 & 'ERROR!!!! message length changed while processing correlations.'
5101 & 'ERROR!!!! message length changed while processing correlations.'
5102 call mp_stopall(Error)
5103 endif ! msglen.eq.msglen1
5104 endif ! MyRank.lt.fgProcs-1
5111 write (iout,'(a)') 'Contact function values:'
5113 write (iout,'(2i3,50(1x,i2,f5.2))')
5114 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5115 & j=1,num_cont_hb(i))
5121 C Remove the loop below after debugging !!!
5128 C Calculate the dipole-dipole interaction energies
5129 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5130 do i=iatel_s,iatel_e+1
5131 num_conti=num_cont_hb(i)
5138 C Calculate the local-electrostatic correlation terms
5139 do i=iatel_s,iatel_e+1
5141 num_conti=num_cont_hb(i)
5142 num_conti1=num_cont_hb(i+1)
5147 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5148 c & ' jj=',jj,' kk=',kk
5149 if (j1.eq.j+1 .or. j1.eq.j-1) then
5150 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5151 C The system gains extra energy.
5153 sqd1=dsqrt(d_cont(jj,i))
5154 sqd2=dsqrt(d_cont(kk,i1))
5155 sred_geom = sqd1*sqd2
5156 IF (sred_geom.lt.cutoff_corr) THEN
5157 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5159 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5160 c & ' jj=',jj,' kk=',kk
5161 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5162 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5164 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5165 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5168 cd write (iout,*) 'sred_geom=',sred_geom,
5169 cd & ' ekont=',ekont,' fprim=',fprimcont
5170 call calc_eello(i,j,i+1,j1,jj,kk)
5171 if (wcorr4.gt.0.0d0)
5172 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5173 if (wcorr5.gt.0.0d0)
5174 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5175 c print *,"wcorr5",ecorr5
5176 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5177 cd write(2,*)'ijkl',i,j,i+1,j1
5178 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5179 & .or. wturn6.eq.0.0d0))then
5180 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5181 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5182 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5183 cd & 'ecorr6=',ecorr6
5184 cd write (iout,'(4e15.5)') sred_geom,
5185 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5186 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5187 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5188 else if (wturn6.gt.0.0d0
5189 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5190 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5191 eturn6=eturn6+eello_turn6(i,jj,kk)
5192 cd write (2,*) 'multibody_eello:eturn6',eturn6
5196 else if (j1.eq.j) then
5197 C Contacts I-J and I-(J+1) occur simultaneously.
5198 C The system loses extra energy.
5199 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5204 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5205 c & ' jj=',jj,' kk=',kk
5207 C Contacts I-J and (I+1)-J occur simultaneously.
5208 C The system loses extra energy.
5209 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5216 c------------------------------------------------------------------------------
5217 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5218 implicit real*8 (a-h,o-z)
5219 include 'DIMENSIONS'
5220 include 'COMMON.IOUNITS'
5221 include 'COMMON.DERIV'
5222 include 'COMMON.INTERACT'
5223 include 'COMMON.CONTACTS'
5224 double precision gx(3),gx1(3)
5234 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5235 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5236 C Following 4 lines for diagnostics.
5241 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5243 c write (iout,*)'Contacts have occurred for peptide groups',
5244 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5245 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5246 C Calculate the multi-body contribution to energy.
5247 ecorr=ecorr+ekont*ees
5249 C Calculate multi-body contributions to the gradient.
5251 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5252 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5253 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5254 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5255 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5256 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5257 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5258 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5259 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5260 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5261 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5262 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5263 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5264 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5268 gradcorr(ll,m)=gradcorr(ll,m)+
5269 & ees*ekl*gacont_hbr(ll,jj,i)-
5270 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5271 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5276 gradcorr(ll,m)=gradcorr(ll,m)+
5277 & ees*eij*gacont_hbr(ll,kk,k)-
5278 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5279 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5286 C---------------------------------------------------------------------------
5287 subroutine dipole(i,j,jj)
5288 implicit real*8 (a-h,o-z)
5289 include 'DIMENSIONS'
5290 include 'DIMENSIONS.ZSCOPT'
5291 include 'COMMON.IOUNITS'
5292 include 'COMMON.CHAIN'
5293 include 'COMMON.FFIELD'
5294 include 'COMMON.DERIV'
5295 include 'COMMON.INTERACT'
5296 include 'COMMON.CONTACTS'
5297 include 'COMMON.TORSION'
5298 include 'COMMON.VAR'
5299 include 'COMMON.GEO'
5300 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5302 iti1 = itortyp(itype(i+1))
5303 if (j.lt.nres-1) then
5304 if (itype(j).le.ntyp) then
5305 itj1 = itortyp(itype(j+1))
5313 dipi(iii,1)=Ub2(iii,i)
5314 dipderi(iii)=Ub2der(iii,i)
5315 dipi(iii,2)=b1(iii,iti1)
5316 dipj(iii,1)=Ub2(iii,j)
5317 dipderj(iii)=Ub2der(iii,j)
5318 dipj(iii,2)=b1(iii,itj1)
5322 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5325 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5328 if (.not.calc_grad) return
5333 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5337 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5342 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5343 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5345 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5347 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5349 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5353 C---------------------------------------------------------------------------
5354 subroutine calc_eello(i,j,k,l,jj,kk)
5356 C This subroutine computes matrices and vectors needed to calculate
5357 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5359 implicit real*8 (a-h,o-z)
5360 include 'DIMENSIONS'
5361 include 'DIMENSIONS.ZSCOPT'
5362 include 'COMMON.IOUNITS'
5363 include 'COMMON.CHAIN'
5364 include 'COMMON.DERIV'
5365 include 'COMMON.INTERACT'
5366 include 'COMMON.CONTACTS'
5367 include 'COMMON.TORSION'
5368 include 'COMMON.VAR'
5369 include 'COMMON.GEO'
5370 include 'COMMON.FFIELD'
5371 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5372 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5375 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5376 cd & ' jj=',jj,' kk=',kk
5377 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5380 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5381 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5384 call transpose2(aa1(1,1),aa1t(1,1))
5385 call transpose2(aa2(1,1),aa2t(1,1))
5388 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5389 & aa1tder(1,1,lll,kkk))
5390 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5391 & aa2tder(1,1,lll,kkk))
5395 C parallel orientation of the two CA-CA-CA frames.
5396 if (i.gt.1 .and. itype(i).le.ntyp) then
5397 iti=itortyp(itype(i))
5401 itk1=itortyp(itype(k+1))
5402 itj=itortyp(itype(j))
5403 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5404 itl1=itortyp(itype(l+1))
5408 C A1 kernel(j+1) A2T
5410 cd write (iout,'(3f10.5,5x,3f10.5)')
5411 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5413 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5414 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5415 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5416 C Following matrices are needed only for 6-th order cumulants
5417 IF (wcorr6.gt.0.0d0) THEN
5418 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5419 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5420 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5421 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5422 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5423 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5424 & ADtEAderx(1,1,1,1,1,1))
5426 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5427 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5428 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5429 & ADtEA1derx(1,1,1,1,1,1))
5431 C End 6-th order cumulants
5434 cd write (2,*) 'In calc_eello6'
5436 cd write (2,*) 'iii=',iii
5438 cd write (2,*) 'kkk=',kkk
5440 cd write (2,'(3(2f10.5),5x)')
5441 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5446 call transpose2(EUgder(1,1,k),auxmat(1,1))
5447 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5448 call transpose2(EUg(1,1,k),auxmat(1,1))
5449 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5450 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5454 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5455 & EAEAderx(1,1,lll,kkk,iii,1))
5459 C A1T kernel(i+1) A2
5460 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5461 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5462 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5463 C Following matrices are needed only for 6-th order cumulants
5464 IF (wcorr6.gt.0.0d0) THEN
5465 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5466 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5467 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5468 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5469 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5470 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5471 & ADtEAderx(1,1,1,1,1,2))
5472 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5473 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5474 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5475 & ADtEA1derx(1,1,1,1,1,2))
5477 C End 6-th order cumulants
5478 call transpose2(EUgder(1,1,l),auxmat(1,1))
5479 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5480 call transpose2(EUg(1,1,l),auxmat(1,1))
5481 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5482 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5486 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5487 & EAEAderx(1,1,lll,kkk,iii,2))
5492 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5493 C They are needed only when the fifth- or the sixth-order cumulants are
5495 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5496 call transpose2(AEA(1,1,1),auxmat(1,1))
5497 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5498 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5499 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5500 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5501 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5502 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5503 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5504 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5505 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5506 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5507 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5508 call transpose2(AEA(1,1,2),auxmat(1,1))
5509 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5510 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5511 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5512 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5513 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5514 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5515 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5516 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5517 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5518 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5519 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5520 C Calculate the Cartesian derivatives of the vectors.
5524 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5525 call matvec2(auxmat(1,1),b1(1,iti),
5526 & AEAb1derx(1,lll,kkk,iii,1,1))
5527 call matvec2(auxmat(1,1),Ub2(1,i),
5528 & AEAb2derx(1,lll,kkk,iii,1,1))
5529 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5530 & AEAb1derx(1,lll,kkk,iii,2,1))
5531 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5532 & AEAb2derx(1,lll,kkk,iii,2,1))
5533 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5534 call matvec2(auxmat(1,1),b1(1,itj),
5535 & AEAb1derx(1,lll,kkk,iii,1,2))
5536 call matvec2(auxmat(1,1),Ub2(1,j),
5537 & AEAb2derx(1,lll,kkk,iii,1,2))
5538 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5539 & AEAb1derx(1,lll,kkk,iii,2,2))
5540 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5541 & AEAb2derx(1,lll,kkk,iii,2,2))
5548 C Antiparallel orientation of the two CA-CA-CA frames.
5549 if (i.gt.1 .and. itype(i).le.ntyp) then
5550 iti=itortyp(itype(i))
5554 itk1=itortyp(itype(k+1))
5555 itl=itortyp(itype(l))
5556 itj=itortyp(itype(j))
5557 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5558 itj1=itortyp(itype(j+1))
5562 C A2 kernel(j-1)T A1T
5563 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5564 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5565 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5566 C Following matrices are needed only for 6-th order cumulants
5567 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5568 & j.eq.i+4 .and. l.eq.i+3)) THEN
5569 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5570 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5571 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5572 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5573 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5574 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5575 & ADtEAderx(1,1,1,1,1,1))
5576 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5577 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5578 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5579 & ADtEA1derx(1,1,1,1,1,1))
5581 C End 6-th order cumulants
5582 call transpose2(EUgder(1,1,k),auxmat(1,1))
5583 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5584 call transpose2(EUg(1,1,k),auxmat(1,1))
5585 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5586 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5590 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5591 & EAEAderx(1,1,lll,kkk,iii,1))
5595 C A2T kernel(i+1)T A1
5596 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5597 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5598 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5599 C Following matrices are needed only for 6-th order cumulants
5600 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5601 & j.eq.i+4 .and. l.eq.i+3)) THEN
5602 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5603 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5604 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5605 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5606 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5607 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5608 & ADtEAderx(1,1,1,1,1,2))
5609 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5610 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5611 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5612 & ADtEA1derx(1,1,1,1,1,2))
5614 C End 6-th order cumulants
5615 call transpose2(EUgder(1,1,j),auxmat(1,1))
5616 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5617 call transpose2(EUg(1,1,j),auxmat(1,1))
5618 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5619 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5623 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5624 & EAEAderx(1,1,lll,kkk,iii,2))
5629 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5630 C They are needed only when the fifth- or the sixth-order cumulants are
5632 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5633 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5634 call transpose2(AEA(1,1,1),auxmat(1,1))
5635 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5636 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5637 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5638 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5639 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5640 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5641 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5642 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5643 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5644 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5645 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5646 call transpose2(AEA(1,1,2),auxmat(1,1))
5647 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5648 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5649 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5650 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5651 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5652 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5653 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5654 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5655 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5656 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5657 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5658 C Calculate the Cartesian derivatives of the vectors.
5662 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5663 call matvec2(auxmat(1,1),b1(1,iti),
5664 & AEAb1derx(1,lll,kkk,iii,1,1))
5665 call matvec2(auxmat(1,1),Ub2(1,i),
5666 & AEAb2derx(1,lll,kkk,iii,1,1))
5667 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5668 & AEAb1derx(1,lll,kkk,iii,2,1))
5669 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5670 & AEAb2derx(1,lll,kkk,iii,2,1))
5671 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5672 call matvec2(auxmat(1,1),b1(1,itl),
5673 & AEAb1derx(1,lll,kkk,iii,1,2))
5674 call matvec2(auxmat(1,1),Ub2(1,l),
5675 & AEAb2derx(1,lll,kkk,iii,1,2))
5676 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5677 & AEAb1derx(1,lll,kkk,iii,2,2))
5678 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5679 & AEAb2derx(1,lll,kkk,iii,2,2))
5688 C---------------------------------------------------------------------------
5689 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5690 & KK,KKderg,AKA,AKAderg,AKAderx)
5694 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5695 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5696 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5701 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5703 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5706 cd if (lprn) write (2,*) 'In kernel'
5708 cd if (lprn) write (2,*) 'kkk=',kkk
5710 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5711 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5713 cd write (2,*) 'lll=',lll
5714 cd write (2,*) 'iii=1'
5716 cd write (2,'(3(2f10.5),5x)')
5717 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5720 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5721 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5723 cd write (2,*) 'lll=',lll
5724 cd write (2,*) 'iii=2'
5726 cd write (2,'(3(2f10.5),5x)')
5727 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5734 C---------------------------------------------------------------------------
5735 double precision function eello4(i,j,k,l,jj,kk)
5736 implicit real*8 (a-h,o-z)
5737 include 'DIMENSIONS'
5738 include 'DIMENSIONS.ZSCOPT'
5739 include 'COMMON.IOUNITS'
5740 include 'COMMON.CHAIN'
5741 include 'COMMON.DERIV'
5742 include 'COMMON.INTERACT'
5743 include 'COMMON.CONTACTS'
5744 include 'COMMON.TORSION'
5745 include 'COMMON.VAR'
5746 include 'COMMON.GEO'
5747 double precision pizda(2,2),ggg1(3),ggg2(3)
5748 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5752 cd print *,'eello4:',i,j,k,l,jj,kk
5753 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5754 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5755 cold eij=facont_hb(jj,i)
5756 cold ekl=facont_hb(kk,k)
5758 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5760 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5761 gcorr_loc(k-1)=gcorr_loc(k-1)
5762 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5764 gcorr_loc(l-1)=gcorr_loc(l-1)
5765 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5767 gcorr_loc(j-1)=gcorr_loc(j-1)
5768 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5773 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5774 & -EAEAderx(2,2,lll,kkk,iii,1)
5775 cd derx(lll,kkk,iii)=0.0d0
5779 cd gcorr_loc(l-1)=0.0d0
5780 cd gcorr_loc(j-1)=0.0d0
5781 cd gcorr_loc(k-1)=0.0d0
5783 cd write (iout,*)'Contacts have occurred for peptide groups',
5784 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5785 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5786 if (j.lt.nres-1) then
5793 if (l.lt.nres-1) then
5801 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5802 ggg1(ll)=eel4*g_contij(ll,1)
5803 ggg2(ll)=eel4*g_contij(ll,2)
5804 ghalf=0.5d0*ggg1(ll)
5806 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5807 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5808 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5809 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5810 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5811 ghalf=0.5d0*ggg2(ll)
5813 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5814 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5815 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5816 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5821 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5822 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5827 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5828 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5834 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5839 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5843 cd write (2,*) iii,gcorr_loc(iii)
5847 cd write (2,*) 'ekont',ekont
5848 cd write (iout,*) 'eello4',ekont*eel4
5851 C---------------------------------------------------------------------------
5852 double precision function eello5(i,j,k,l,jj,kk)
5853 implicit real*8 (a-h,o-z)
5854 include 'DIMENSIONS'
5855 include 'DIMENSIONS.ZSCOPT'
5856 include 'COMMON.IOUNITS'
5857 include 'COMMON.CHAIN'
5858 include 'COMMON.DERIV'
5859 include 'COMMON.INTERACT'
5860 include 'COMMON.CONTACTS'
5861 include 'COMMON.TORSION'
5862 include 'COMMON.VAR'
5863 include 'COMMON.GEO'
5864 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5865 double precision ggg1(3),ggg2(3)
5866 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5871 C /l\ / \ \ / \ / \ / C
5872 C / \ / \ \ / \ / \ / C
5873 C j| o |l1 | o | o| o | | o |o C
5874 C \ |/k\| |/ \| / |/ \| |/ \| C
5875 C \i/ \ / \ / / \ / \ C
5877 C (I) (II) (III) (IV) C
5879 C eello5_1 eello5_2 eello5_3 eello5_4 C
5881 C Antiparallel chains C
5884 C /j\ / \ \ / \ / \ / C
5885 C / \ / \ \ / \ / \ / C
5886 C j1| o |l | o | o| o | | o |o C
5887 C \ |/k\| |/ \| / |/ \| |/ \| C
5888 C \i/ \ / \ / / \ / \ C
5890 C (I) (II) (III) (IV) C
5892 C eello5_1 eello5_2 eello5_3 eello5_4 C
5894 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5896 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5897 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5902 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5904 itk=itortyp(itype(k))
5905 itl=itortyp(itype(l))
5906 itj=itortyp(itype(j))
5911 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5912 cd & eel5_3_num,eel5_4_num)
5916 derx(lll,kkk,iii)=0.0d0
5920 cd eij=facont_hb(jj,i)
5921 cd ekl=facont_hb(kk,k)
5923 cd write (iout,*)'Contacts have occurred for peptide groups',
5924 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5926 C Contribution from the graph I.
5927 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5928 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5929 call transpose2(EUg(1,1,k),auxmat(1,1))
5930 call matmat2(AEA(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)
5933 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5934 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5936 C Explicit gradient in virtual-dihedral angles.
5937 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5938 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5939 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5940 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5941 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5942 vv(1)=pizda(1,1)-pizda(2,2)
5943 vv(2)=pizda(1,2)+pizda(2,1)
5944 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5945 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5946 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5947 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5948 vv(1)=pizda(1,1)-pizda(2,2)
5949 vv(2)=pizda(1,2)+pizda(2,1)
5951 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5952 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5953 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5955 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5956 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5957 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5959 C Cartesian gradient
5963 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5965 vv(1)=pizda(1,1)-pizda(2,2)
5966 vv(2)=pizda(1,2)+pizda(2,1)
5967 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5968 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5969 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5976 C Contribution from graph II
5977 call transpose2(EE(1,1,itk),auxmat(1,1))
5978 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5979 vv(1)=pizda(1,1)+pizda(2,2)
5980 vv(2)=pizda(2,1)-pizda(1,2)
5981 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5982 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5984 C Explicit gradient in virtual-dihedral angles.
5985 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5986 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5987 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5988 vv(1)=pizda(1,1)+pizda(2,2)
5989 vv(2)=pizda(2,1)-pizda(1,2)
5991 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5992 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5993 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5995 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5996 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5997 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5999 C Cartesian gradient
6003 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6005 vv(1)=pizda(1,1)+pizda(2,2)
6006 vv(2)=pizda(2,1)-pizda(1,2)
6007 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6008 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6009 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6018 C Parallel orientation
6019 C Contribution from graph III
6020 call transpose2(EUg(1,1,l),auxmat(1,1))
6021 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6022 vv(1)=pizda(1,1)-pizda(2,2)
6023 vv(2)=pizda(1,2)+pizda(2,1)
6024 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6025 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6027 C Explicit gradient in virtual-dihedral angles.
6028 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6029 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6030 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6031 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6032 vv(1)=pizda(1,1)-pizda(2,2)
6033 vv(2)=pizda(1,2)+pizda(2,1)
6034 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6035 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6036 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6037 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6038 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6039 vv(1)=pizda(1,1)-pizda(2,2)
6040 vv(2)=pizda(1,2)+pizda(2,1)
6041 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6042 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6043 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6044 C Cartesian gradient
6048 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6050 vv(1)=pizda(1,1)-pizda(2,2)
6051 vv(2)=pizda(1,2)+pizda(2,1)
6052 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6053 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6054 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6060 C Contribution from graph IV
6062 call transpose2(EE(1,1,itl),auxmat(1,1))
6063 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6064 vv(1)=pizda(1,1)+pizda(2,2)
6065 vv(2)=pizda(2,1)-pizda(1,2)
6066 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6067 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6069 C Explicit gradient in virtual-dihedral angles.
6070 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6071 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6072 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6073 vv(1)=pizda(1,1)+pizda(2,2)
6074 vv(2)=pizda(2,1)-pizda(1,2)
6075 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6076 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6077 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6078 C Cartesian gradient
6082 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6084 vv(1)=pizda(1,1)+pizda(2,2)
6085 vv(2)=pizda(2,1)-pizda(1,2)
6086 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6087 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6088 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6094 C Antiparallel orientation
6095 C Contribution from graph III
6097 call transpose2(EUg(1,1,j),auxmat(1,1))
6098 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6099 vv(1)=pizda(1,1)-pizda(2,2)
6100 vv(2)=pizda(1,2)+pizda(2,1)
6101 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6102 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6104 C Explicit gradient in virtual-dihedral angles.
6105 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6106 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6107 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6108 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6109 vv(1)=pizda(1,1)-pizda(2,2)
6110 vv(2)=pizda(1,2)+pizda(2,1)
6111 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6112 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6113 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6114 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6115 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6116 vv(1)=pizda(1,1)-pizda(2,2)
6117 vv(2)=pizda(1,2)+pizda(2,1)
6118 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6119 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6120 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6121 C Cartesian gradient
6125 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6127 vv(1)=pizda(1,1)-pizda(2,2)
6128 vv(2)=pizda(1,2)+pizda(2,1)
6129 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6130 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6131 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6137 C Contribution from graph IV
6139 call transpose2(EE(1,1,itj),auxmat(1,1))
6140 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6141 vv(1)=pizda(1,1)+pizda(2,2)
6142 vv(2)=pizda(2,1)-pizda(1,2)
6143 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6144 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6146 C Explicit gradient in virtual-dihedral angles.
6147 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6148 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6149 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6150 vv(1)=pizda(1,1)+pizda(2,2)
6151 vv(2)=pizda(2,1)-pizda(1,2)
6152 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6153 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6154 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6155 C Cartesian gradient
6159 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6161 vv(1)=pizda(1,1)+pizda(2,2)
6162 vv(2)=pizda(2,1)-pizda(1,2)
6163 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6164 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6165 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6172 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6173 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6174 cd write (2,*) 'ijkl',i,j,k,l
6175 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6176 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6178 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6179 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6180 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6181 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6183 if (j.lt.nres-1) then
6190 if (l.lt.nres-1) then
6200 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6202 ggg1(ll)=eel5*g_contij(ll,1)
6203 ggg2(ll)=eel5*g_contij(ll,2)
6204 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6205 ghalf=0.5d0*ggg1(ll)
6207 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6208 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6209 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6210 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6211 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6212 ghalf=0.5d0*ggg2(ll)
6214 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6215 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6216 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6217 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6222 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6223 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6228 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6229 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6235 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6240 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6244 cd write (2,*) iii,g_corr5_loc(iii)
6248 cd write (2,*) 'ekont',ekont
6249 cd write (iout,*) 'eello5',ekont*eel5
6252 c--------------------------------------------------------------------------
6253 double precision function eello6(i,j,k,l,jj,kk)
6254 implicit real*8 (a-h,o-z)
6255 include 'DIMENSIONS'
6256 include 'DIMENSIONS.ZSCOPT'
6257 include 'COMMON.IOUNITS'
6258 include 'COMMON.CHAIN'
6259 include 'COMMON.DERIV'
6260 include 'COMMON.INTERACT'
6261 include 'COMMON.CONTACTS'
6262 include 'COMMON.TORSION'
6263 include 'COMMON.VAR'
6264 include 'COMMON.GEO'
6265 include 'COMMON.FFIELD'
6266 double precision ggg1(3),ggg2(3)
6267 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6272 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6280 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6281 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6285 derx(lll,kkk,iii)=0.0d0
6289 cd eij=facont_hb(jj,i)
6290 cd ekl=facont_hb(kk,k)
6296 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6297 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6298 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6299 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6300 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6301 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6303 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6304 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6305 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6306 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6307 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6308 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6312 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6314 C If turn contributions are considered, they will be handled separately.
6315 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6316 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6317 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6318 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6319 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6320 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6321 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6324 if (j.lt.nres-1) then
6331 if (l.lt.nres-1) then
6339 ggg1(ll)=eel6*g_contij(ll,1)
6340 ggg2(ll)=eel6*g_contij(ll,2)
6341 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6342 ghalf=0.5d0*ggg1(ll)
6344 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6345 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6346 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6347 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6348 ghalf=0.5d0*ggg2(ll)
6349 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6351 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6352 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6353 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6354 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6359 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6360 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6365 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6366 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6372 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6377 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6381 cd write (2,*) iii,g_corr6_loc(iii)
6385 cd write (2,*) 'ekont',ekont
6386 cd write (iout,*) 'eello6',ekont*eel6
6389 c--------------------------------------------------------------------------
6390 double precision function eello6_graph1(i,j,k,l,imat,swap)
6391 implicit real*8 (a-h,o-z)
6392 include 'DIMENSIONS'
6393 include 'DIMENSIONS.ZSCOPT'
6394 include 'COMMON.IOUNITS'
6395 include 'COMMON.CHAIN'
6396 include 'COMMON.DERIV'
6397 include 'COMMON.INTERACT'
6398 include 'COMMON.CONTACTS'
6399 include 'COMMON.TORSION'
6400 include 'COMMON.VAR'
6401 include 'COMMON.GEO'
6402 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6406 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6408 C Parallel Antiparallel C
6414 C \ j|/k\| / \ |/k\|l / C
6419 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6420 itk=itortyp(itype(k))
6421 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6422 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6423 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6424 call transpose2(EUgC(1,1,k),auxmat(1,1))
6425 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6426 vv1(1)=pizda1(1,1)-pizda1(2,2)
6427 vv1(2)=pizda1(1,2)+pizda1(2,1)
6428 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6429 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6430 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6431 s5=scalar2(vv(1),Dtobr2(1,i))
6432 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6433 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6434 if (.not. calc_grad) return
6435 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6436 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6437 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6438 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6439 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6440 & +scalar2(vv(1),Dtobr2der(1,i)))
6441 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6442 vv1(1)=pizda1(1,1)-pizda1(2,2)
6443 vv1(2)=pizda1(1,2)+pizda1(2,1)
6444 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6445 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6447 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6448 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6449 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6450 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6451 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6453 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6454 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6455 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6456 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6457 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6459 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6460 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6461 vv1(1)=pizda1(1,1)-pizda1(2,2)
6462 vv1(2)=pizda1(1,2)+pizda1(2,1)
6463 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6464 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6465 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6466 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6475 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6476 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6477 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6478 call transpose2(EUgC(1,1,k),auxmat(1,1))
6479 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6481 vv1(1)=pizda1(1,1)-pizda1(2,2)
6482 vv1(2)=pizda1(1,2)+pizda1(2,1)
6483 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6484 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6485 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6486 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6487 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6488 s5=scalar2(vv(1),Dtobr2(1,i))
6489 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6495 c----------------------------------------------------------------------------
6496 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6497 implicit real*8 (a-h,o-z)
6498 include 'DIMENSIONS'
6499 include 'DIMENSIONS.ZSCOPT'
6500 include 'COMMON.IOUNITS'
6501 include 'COMMON.CHAIN'
6502 include 'COMMON.DERIV'
6503 include 'COMMON.INTERACT'
6504 include 'COMMON.CONTACTS'
6505 include 'COMMON.TORSION'
6506 include 'COMMON.VAR'
6507 include 'COMMON.GEO'
6509 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6510 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6513 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6515 C Parallel Antiparallel C
6521 C \ j|/k\| \ |/k\|l C
6526 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6527 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6528 C AL 7/4/01 s1 would occur in the sixth-order moment,
6529 C but not in a cluster cumulant
6531 s1=dip(1,jj,i)*dip(1,kk,k)
6533 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6534 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6535 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6536 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6537 call transpose2(EUg(1,1,k),auxmat(1,1))
6538 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6539 vv(1)=pizda(1,1)-pizda(2,2)
6540 vv(2)=pizda(1,2)+pizda(2,1)
6541 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6542 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6544 eello6_graph2=-(s1+s2+s3+s4)
6546 eello6_graph2=-(s2+s3+s4)
6549 if (.not. calc_grad) return
6550 C Derivatives in gamma(i-1)
6553 s1=dipderg(1,jj,i)*dip(1,kk,k)
6555 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6556 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6557 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6558 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6560 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6562 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6564 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6566 C Derivatives in gamma(k-1)
6568 s1=dip(1,jj,i)*dipderg(1,kk,k)
6570 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6571 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6572 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6573 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6574 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6575 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6576 vv(1)=pizda(1,1)-pizda(2,2)
6577 vv(2)=pizda(1,2)+pizda(2,1)
6578 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6580 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6582 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6584 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6585 C Derivatives in gamma(j-1) or gamma(l-1)
6588 s1=dipderg(3,jj,i)*dip(1,kk,k)
6590 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6591 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6592 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6593 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6594 vv(1)=pizda(1,1)-pizda(2,2)
6595 vv(2)=pizda(1,2)+pizda(2,1)
6596 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6599 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6601 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6604 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6605 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6607 C Derivatives in gamma(l-1) or gamma(j-1)
6610 s1=dip(1,jj,i)*dipderg(3,kk,k)
6612 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6613 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6614 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6615 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6616 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6617 vv(1)=pizda(1,1)-pizda(2,2)
6618 vv(2)=pizda(1,2)+pizda(2,1)
6619 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6622 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6624 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6627 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6628 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6630 C Cartesian derivatives.
6632 write (2,*) 'In eello6_graph2'
6634 write (2,*) 'iii=',iii
6636 write (2,*) 'kkk=',kkk
6638 write (2,'(3(2f10.5),5x)')
6639 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6649 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6651 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6654 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6656 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6657 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6659 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6660 call transpose2(EUg(1,1,k),auxmat(1,1))
6661 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6663 vv(1)=pizda(1,1)-pizda(2,2)
6664 vv(2)=pizda(1,2)+pizda(2,1)
6665 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6666 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6668 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6670 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6673 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6675 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6682 c----------------------------------------------------------------------------
6683 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6684 implicit real*8 (a-h,o-z)
6685 include 'DIMENSIONS'
6686 include 'DIMENSIONS.ZSCOPT'
6687 include 'COMMON.IOUNITS'
6688 include 'COMMON.CHAIN'
6689 include 'COMMON.DERIV'
6690 include 'COMMON.INTERACT'
6691 include 'COMMON.CONTACTS'
6692 include 'COMMON.TORSION'
6693 include 'COMMON.VAR'
6694 include 'COMMON.GEO'
6695 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6697 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6699 C Parallel Antiparallel C
6705 C j|/k\| / |/k\|l / C
6710 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6712 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6713 C energy moment and not to the cluster cumulant.
6714 iti=itortyp(itype(i))
6715 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6716 itj1=itortyp(itype(j+1))
6720 itk=itortyp(itype(k))
6721 itk1=itortyp(itype(k+1))
6722 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6723 itl1=itortyp(itype(l+1))
6728 s1=dip(4,jj,i)*dip(4,kk,k)
6730 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6731 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6732 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6733 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6734 call transpose2(EE(1,1,itk),auxmat(1,1))
6735 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6736 vv(1)=pizda(1,1)+pizda(2,2)
6737 vv(2)=pizda(2,1)-pizda(1,2)
6738 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6739 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6741 eello6_graph3=-(s1+s2+s3+s4)
6743 eello6_graph3=-(s2+s3+s4)
6746 if (.not. calc_grad) return
6747 C Derivatives in gamma(k-1)
6748 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6749 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6750 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6751 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6752 C Derivatives in gamma(l-1)
6753 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6754 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6755 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6756 vv(1)=pizda(1,1)+pizda(2,2)
6757 vv(2)=pizda(2,1)-pizda(1,2)
6758 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6759 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6760 C Cartesian derivatives.
6766 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6768 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6771 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6773 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6774 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6776 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6777 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6779 vv(1)=pizda(1,1)+pizda(2,2)
6780 vv(2)=pizda(2,1)-pizda(1,2)
6781 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6783 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6785 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6788 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6790 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6792 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6798 c----------------------------------------------------------------------------
6799 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6800 implicit real*8 (a-h,o-z)
6801 include 'DIMENSIONS'
6802 include 'DIMENSIONS.ZSCOPT'
6803 include 'COMMON.IOUNITS'
6804 include 'COMMON.CHAIN'
6805 include 'COMMON.DERIV'
6806 include 'COMMON.INTERACT'
6807 include 'COMMON.CONTACTS'
6808 include 'COMMON.TORSION'
6809 include 'COMMON.VAR'
6810 include 'COMMON.GEO'
6811 include 'COMMON.FFIELD'
6812 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6813 & auxvec1(2),auxmat1(2,2)
6815 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6817 C Parallel Antiparallel C
6823 C \ j|/k\| \ |/k\|l C
6828 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6830 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6831 C energy moment and not to the cluster cumulant.
6832 cd write (2,*) 'eello_graph4: wturn6',wturn6
6833 iti=itortyp(itype(i))
6834 itj=itortyp(itype(j))
6835 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6836 itj1=itortyp(itype(j+1))
6840 itk=itortyp(itype(k))
6841 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6842 itk1=itortyp(itype(k+1))
6846 itl=itortyp(itype(l))
6847 if (l.lt.nres-1) then
6848 itl1=itortyp(itype(l+1))
6852 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6853 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6854 cd & ' itl',itl,' itl1',itl1
6857 s1=dip(3,jj,i)*dip(3,kk,k)
6859 s1=dip(2,jj,j)*dip(2,kk,l)
6862 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6863 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6865 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6866 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6868 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6869 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6871 call transpose2(EUg(1,1,k),auxmat(1,1))
6872 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6873 vv(1)=pizda(1,1)-pizda(2,2)
6874 vv(2)=pizda(2,1)+pizda(1,2)
6875 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6876 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6878 eello6_graph4=-(s1+s2+s3+s4)
6880 eello6_graph4=-(s2+s3+s4)
6882 if (.not. calc_grad) return
6883 C Derivatives in gamma(i-1)
6887 s1=dipderg(2,jj,i)*dip(3,kk,k)
6889 s1=dipderg(4,jj,j)*dip(2,kk,l)
6892 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6894 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6895 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6897 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6898 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6900 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6901 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6902 cd write (2,*) 'turn6 derivatives'
6904 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6906 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6910 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6912 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6916 C Derivatives in gamma(k-1)
6919 s1=dip(3,jj,i)*dipderg(2,kk,k)
6921 s1=dip(2,jj,j)*dipderg(4,kk,l)
6924 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6925 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6927 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6928 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6930 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6931 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6933 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6934 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6935 vv(1)=pizda(1,1)-pizda(2,2)
6936 vv(2)=pizda(2,1)+pizda(1,2)
6937 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6938 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6940 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6942 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6946 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6948 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6951 C Derivatives in gamma(j-1) or gamma(l-1)
6952 if (l.eq.j+1 .and. l.gt.1) then
6953 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6954 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6955 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6956 vv(1)=pizda(1,1)-pizda(2,2)
6957 vv(2)=pizda(2,1)+pizda(1,2)
6958 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6959 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6960 else if (j.gt.1) then
6961 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6962 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6963 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6964 vv(1)=pizda(1,1)-pizda(2,2)
6965 vv(2)=pizda(2,1)+pizda(1,2)
6966 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6967 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6968 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6970 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6973 C Cartesian derivatives.
6980 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6982 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6986 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6988 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6992 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6994 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6996 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6997 & b1(1,itj1),auxvec(1))
6998 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7000 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7001 & b1(1,itl1),auxvec(1))
7002 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7004 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7006 vv(1)=pizda(1,1)-pizda(2,2)
7007 vv(2)=pizda(2,1)+pizda(1,2)
7008 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7010 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7012 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7015 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7018 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7021 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7023 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7025 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7029 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7031 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7034 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7036 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7044 c----------------------------------------------------------------------------
7045 double precision function eello_turn6(i,jj,kk)
7046 implicit real*8 (a-h,o-z)
7047 include 'DIMENSIONS'
7048 include 'DIMENSIONS.ZSCOPT'
7049 include 'COMMON.IOUNITS'
7050 include 'COMMON.CHAIN'
7051 include 'COMMON.DERIV'
7052 include 'COMMON.INTERACT'
7053 include 'COMMON.CONTACTS'
7054 include 'COMMON.TORSION'
7055 include 'COMMON.VAR'
7056 include 'COMMON.GEO'
7057 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7058 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7060 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7061 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7062 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7063 C the respective energy moment and not to the cluster cumulant.
7068 iti=itortyp(itype(i))
7069 itk=itortyp(itype(k))
7070 itk1=itortyp(itype(k+1))
7071 itl=itortyp(itype(l))
7072 itj=itortyp(itype(j))
7073 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7074 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7075 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7080 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7082 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7086 derx_turn(lll,kkk,iii)=0.0d0
7093 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7095 cd write (2,*) 'eello6_5',eello6_5
7097 call transpose2(AEA(1,1,1),auxmat(1,1))
7098 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7099 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7100 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7104 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7105 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7106 s2 = scalar2(b1(1,itk),vtemp1(1))
7108 call transpose2(AEA(1,1,2),atemp(1,1))
7109 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7110 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7111 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7115 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7116 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7117 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7119 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7120 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7121 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7122 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7123 ss13 = scalar2(b1(1,itk),vtemp4(1))
7124 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7128 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7134 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7136 C Derivatives in gamma(i+2)
7138 call transpose2(AEA(1,1,1),auxmatd(1,1))
7139 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7140 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7141 call transpose2(AEAderg(1,1,2),atempd(1,1))
7142 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7143 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7147 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7148 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7149 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7155 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7156 C Derivatives in gamma(i+3)
7158 call transpose2(AEA(1,1,1),auxmatd(1,1))
7159 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7160 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7161 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7165 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7166 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7167 s2d = scalar2(b1(1,itk),vtemp1d(1))
7169 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7170 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7172 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7174 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7175 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7176 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7186 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7187 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7189 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7190 & -0.5d0*ekont*(s2d+s12d)
7192 C Derivatives in gamma(i+4)
7193 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7194 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7195 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7197 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7198 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7199 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7209 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7211 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7213 C Derivatives in gamma(i+5)
7215 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7216 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7217 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7221 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7222 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7223 s2d = scalar2(b1(1,itk),vtemp1d(1))
7225 call transpose2(AEA(1,1,2),atempd(1,1))
7226 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7227 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7231 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7232 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7234 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7235 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7236 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7246 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7247 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7249 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7250 & -0.5d0*ekont*(s2d+s12d)
7252 C Cartesian derivatives
7257 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7258 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7259 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7263 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7264 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7266 s2d = scalar2(b1(1,itk),vtemp1d(1))
7268 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7269 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7270 s8d = -(atempd(1,1)+atempd(2,2))*
7271 & scalar2(cc(1,1,itl),vtemp2(1))
7275 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7277 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7278 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7285 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7288 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7292 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7293 & - 0.5d0*(s8d+s12d)
7295 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7304 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7306 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7307 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7308 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7309 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7310 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7312 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7313 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7314 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7318 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7319 cd & 16*eel_turn6_num
7321 if (j.lt.nres-1) then
7328 if (l.lt.nres-1) then
7336 ggg1(ll)=eel_turn6*g_contij(ll,1)
7337 ggg2(ll)=eel_turn6*g_contij(ll,2)
7338 ghalf=0.5d0*ggg1(ll)
7340 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7341 & +ekont*derx_turn(ll,2,1)
7342 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7343 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7344 & +ekont*derx_turn(ll,4,1)
7345 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7346 ghalf=0.5d0*ggg2(ll)
7348 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7349 & +ekont*derx_turn(ll,2,2)
7350 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7351 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7352 & +ekont*derx_turn(ll,4,2)
7353 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7358 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7363 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7369 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7374 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7378 cd write (2,*) iii,g_corr6_loc(iii)
7381 eello_turn6=ekont*eel_turn6
7382 cd write (2,*) 'ekont',ekont
7383 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7386 crc-------------------------------------------------
7387 SUBROUTINE MATVEC2(A1,V1,V2)
7388 implicit real*8 (a-h,o-z)
7389 include 'DIMENSIONS'
7390 DIMENSION A1(2,2),V1(2),V2(2)
7394 c 3 VI=VI+A1(I,K)*V1(K)
7398 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7399 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7404 C---------------------------------------
7405 SUBROUTINE MATMAT2(A1,A2,A3)
7406 implicit real*8 (a-h,o-z)
7407 include 'DIMENSIONS'
7408 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7409 c DIMENSION AI3(2,2)
7413 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7419 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7420 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7421 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7422 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7430 c-------------------------------------------------------------------------
7431 double precision function scalar2(u,v)
7433 double precision u(2),v(2)
7436 scalar2=u(1)*v(1)+u(2)*v(2)
7440 C-----------------------------------------------------------------------------
7442 subroutine transpose2(a,at)
7444 double precision a(2,2),at(2,2)
7451 c--------------------------------------------------------------------------
7452 subroutine transpose(n,a,at)
7455 double precision a(n,n),at(n,n)
7463 C---------------------------------------------------------------------------
7464 subroutine prodmat3(a1,a2,kk,transp,prod)
7467 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7469 crc double precision auxmat(2,2),prod_(2,2)
7472 crc call transpose2(kk(1,1),auxmat(1,1))
7473 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7474 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7476 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7477 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7478 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7479 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7480 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7481 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7482 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7483 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7486 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7487 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7489 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7490 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7491 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7492 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7493 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7494 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7495 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7496 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7499 c call transpose2(a2(1,1),a2t(1,1))
7502 crc print *,((prod_(i,j),i=1,2),j=1,2)
7503 crc print *,((prod(i,j),i=1,2),j=1,2)
7507 C-----------------------------------------------------------------------------
7508 double precision function scalar(u,v)
7510 double precision u(3),v(3)