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)
231 c & +wsccor*fact(1)*gsccor_loc(i)
232 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
235 if (dyn_ss) call dyn_set_nss
238 C------------------------------------------------------------------------
239 subroutine enerprint(energia,fact)
240 implicit real*8 (a-h,o-z)
242 include 'DIMENSIONS.ZSCOPT'
243 include 'COMMON.IOUNITS'
244 include 'COMMON.FFIELD'
245 include 'COMMON.SBRIDGE'
246 double precision energia(0:max_ene),fact(6)
248 evdw=energia(1)+fact(6)*energia(21)
250 evdw2=energia(2)+energia(17)
262 eello_turn3=energia(8)
263 eello_turn4=energia(9)
264 eello_turn6=energia(10)
271 edihcnstr=energia(20)
274 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
276 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
277 & etors_d,wtor_d*fact(2),ehpb,wstrain,
278 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
279 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
280 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
281 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
282 10 format (/'Virtual-chain energies:'//
283 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
284 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
285 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
286 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
287 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
288 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
289 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
290 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
291 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
292 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
293 & ' (SS bridges & dist. cnstr.)'/
294 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
297 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
298 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
299 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
300 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
301 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
302 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
303 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
304 & 'ETOT= ',1pE16.6,' (total)')
306 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
307 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
308 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
309 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
310 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
311 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
312 & edihcnstr,ebr*nss,etot
313 10 format (/'Virtual-chain energies:'//
314 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
315 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
316 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
317 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
318 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
319 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
320 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
321 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
322 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
323 & ' (SS bridges & dist. cnstr.)'/
324 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
327 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
328 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
329 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
330 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
331 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
332 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
333 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
334 & 'ETOT= ',1pE16.6,' (total)')
338 C-----------------------------------------------------------------------
339 subroutine elj(evdw,evdw_t)
341 C This subroutine calculates the interaction energy of nonbonded side chains
342 C assuming the LJ potential of interaction.
344 implicit real*8 (a-h,o-z)
346 include 'DIMENSIONS.ZSCOPT'
347 include "DIMENSIONS.COMPAR"
348 parameter (accur=1.0d-10)
351 include 'COMMON.LOCAL'
352 include 'COMMON.CHAIN'
353 include 'COMMON.DERIV'
354 include 'COMMON.INTERACT'
355 include 'COMMON.TORSION'
356 include 'COMMON.ENEPS'
357 include 'COMMON.SBRIDGE'
358 include 'COMMON.NAMES'
359 include 'COMMON.IOUNITS'
360 include 'COMMON.CONTACTS'
364 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
368 eneps_temp(j,i)=0.0d0
377 if (itypi.eq.ntyp1) cycle
378 itypi1=iabs(itype(i+1))
385 C Calculate SC interaction energy.
388 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
389 cd & 'iend=',iend(i,iint)
390 do j=istart(i,iint),iend(i,iint)
392 if (itypj.eq.ntyp1) cycle
396 C Change 12/1/95 to calculate four-body interactions
397 rij=xj*xj+yj*yj+zj*zj
399 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
400 eps0ij=eps(itypi,itypj)
402 e1=fac*fac*aa(itypi,itypj)
403 e2=fac*bb(itypi,itypj)
405 ij=icant(itypi,itypj)
407 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
408 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
411 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
412 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
413 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
414 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
415 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
416 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
417 if (bb(itypi,itypj).gt.0.0d0) then
424 C Calculate the components of the gradient in DC and X
426 fac=-rrij*(e1+evdwij)
431 gvdwx(k,i)=gvdwx(k,i)-gg(k)
432 gvdwx(k,j)=gvdwx(k,j)+gg(k)
436 gvdwc(l,k)=gvdwc(l,k)+gg(l)
441 C 12/1/95, revised on 5/20/97
443 C Calculate the contact function. The ith column of the array JCONT will
444 C contain the numbers of atoms that make contacts with the atom I (of numbers
445 C greater than I). The arrays FACONT and GACONT will contain the values of
446 C the contact function and its derivative.
448 C Uncomment next line, if the correlation interactions include EVDW explicitly.
449 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
450 C Uncomment next line, if the correlation interactions are contact function only
451 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
453 sigij=sigma(itypi,itypj)
454 r0ij=rs0(itypi,itypj)
456 C Check whether the SC's are not too far to make a contact.
459 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
460 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
462 if (fcont.gt.0.0D0) then
463 C If the SC-SC distance if close to sigma, apply spline.
464 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
465 cAdam & fcont1,fprimcont1)
466 cAdam fcont1=1.0d0-fcont1
467 cAdam if (fcont1.gt.0.0d0) then
468 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
469 cAdam fcont=fcont*fcont1
471 C Uncomment following 4 lines to have the geometric average of the epsilon0's
472 cga eps0ij=1.0d0/dsqrt(eps0ij)
474 cga gg(k)=gg(k)*eps0ij
476 cga eps0ij=-evdwij*eps0ij
477 C Uncomment for AL's type of SC correlation interactions.
479 num_conti=num_conti+1
481 facont(num_conti,i)=fcont*eps0ij
482 fprimcont=eps0ij*fprimcont/rij
484 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
485 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
486 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
487 C Uncomment following 3 lines for Skolnick's type of SC correlation.
488 gacont(1,num_conti,i)=-fprimcont*xj
489 gacont(2,num_conti,i)=-fprimcont*yj
490 gacont(3,num_conti,i)=-fprimcont*zj
491 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
492 cd write (iout,'(2i3,3f10.5)')
493 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
499 num_cont(i)=num_conti
504 gvdwc(j,i)=expon*gvdwc(j,i)
505 gvdwx(j,i)=expon*gvdwx(j,i)
509 C******************************************************************************
513 C To save time, the factor of EXPON has been extracted from ALL components
514 C of GVDWC and GRADX. Remember to multiply them by this factor before further
517 C******************************************************************************
520 C-----------------------------------------------------------------------------
521 subroutine eljk(evdw,evdw_t)
523 C This subroutine calculates the interaction energy of nonbonded side chains
524 C assuming the LJK potential of interaction.
526 implicit real*8 (a-h,o-z)
528 include 'DIMENSIONS.ZSCOPT'
529 include "DIMENSIONS.COMPAR"
532 include 'COMMON.LOCAL'
533 include 'COMMON.CHAIN'
534 include 'COMMON.DERIV'
535 include 'COMMON.INTERACT'
536 include 'COMMON.ENEPS'
537 include 'COMMON.IOUNITS'
538 include 'COMMON.NAMES'
543 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
546 eneps_temp(j,i)=0.0d0
553 if (itypi.eq.ntyp1) cycle
554 itypi1=iabs(itype(i+1))
559 C Calculate SC interaction energy.
562 do j=istart(i,iint),iend(i,iint)
564 if (itypj.eq.ntyp1) cycle
568 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
570 e_augm=augm(itypi,itypj)*fac_augm
573 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
574 fac=r_shift_inv**expon
575 e1=fac*fac*aa(itypi,itypj)
576 e2=fac*bb(itypi,itypj)
578 ij=icant(itypi,itypj)
579 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
580 & /dabs(eps(itypi,itypj))
581 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
582 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
583 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
584 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
585 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
586 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
587 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
588 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
589 if (bb(itypi,itypj).gt.0.0d0) then
596 C Calculate the components of the gradient in DC and X
598 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
603 gvdwx(k,i)=gvdwx(k,i)-gg(k)
604 gvdwx(k,j)=gvdwx(k,j)+gg(k)
608 gvdwc(l,k)=gvdwc(l,k)+gg(l)
618 gvdwc(j,i)=expon*gvdwc(j,i)
619 gvdwx(j,i)=expon*gvdwx(j,i)
625 C-----------------------------------------------------------------------------
626 subroutine ebp(evdw,evdw_t)
628 C This subroutine calculates the interaction energy of nonbonded side chains
629 C assuming the Berne-Pechukas potential of interaction.
631 implicit real*8 (a-h,o-z)
633 include 'DIMENSIONS.ZSCOPT'
634 include "DIMENSIONS.COMPAR"
637 include 'COMMON.LOCAL'
638 include 'COMMON.CHAIN'
639 include 'COMMON.DERIV'
640 include 'COMMON.NAMES'
641 include 'COMMON.INTERACT'
642 include 'COMMON.ENEPS'
643 include 'COMMON.IOUNITS'
644 include 'COMMON.CALC'
646 c double precision rrsave(maxdim)
652 eneps_temp(j,i)=0.0d0
657 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
658 c if (icall.eq.0) then
666 if (itypi.eq.ntyp1) cycle
667 itypi1=iabs(itype(i+1))
671 dxi=dc_norm(1,nres+i)
672 dyi=dc_norm(2,nres+i)
673 dzi=dc_norm(3,nres+i)
674 dsci_inv=vbld_inv(i+nres)
676 C Calculate SC interaction energy.
679 do j=istart(i,iint),iend(i,iint)
682 if (itypj.eq.ntyp1) cycle
683 dscj_inv=vbld_inv(j+nres)
684 chi1=chi(itypi,itypj)
685 chi2=chi(itypj,itypi)
692 alf12=0.5D0*(alf1+alf2)
693 C For diagnostics only!!!
706 dxj=dc_norm(1,nres+j)
707 dyj=dc_norm(2,nres+j)
708 dzj=dc_norm(3,nres+j)
709 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
710 cd if (icall.eq.0) then
716 C Calculate the angle-dependent terms of energy & contributions to derivatives.
718 C Calculate whole angle-dependent part of epsilon and contributions
720 fac=(rrij*sigsq)**expon2
721 e1=fac*fac*aa(itypi,itypj)
722 e2=fac*bb(itypi,itypj)
723 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
724 eps2der=evdwij*eps3rt
725 eps3der=evdwij*eps2rt
726 evdwij=evdwij*eps2rt*eps3rt
727 ij=icant(itypi,itypj)
728 aux=eps1*eps2rt**2*eps3rt**2
729 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
730 & /dabs(eps(itypi,itypj))
731 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
732 if (bb(itypi,itypj).gt.0.0d0) then
739 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
740 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
741 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
742 & restyp(itypi),i,restyp(itypj),j,
743 & epsi,sigm,chi1,chi2,chip1,chip2,
744 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
745 & om1,om2,om12,1.0D0/dsqrt(rrij),
748 C Calculate gradient components.
749 e1=e1*eps1*eps2rt**2*eps3rt**2
750 fac=-expon*(e1+evdwij)
753 C Calculate radial part of the gradient
757 C Calculate the angular part of the gradient and sum add the contributions
758 C to the appropriate components of the Cartesian gradient.
767 C-----------------------------------------------------------------------------
768 subroutine egb(evdw,evdw_t)
770 C This subroutine calculates the interaction energy of nonbonded side chains
771 C assuming the Gay-Berne potential of interaction.
773 implicit real*8 (a-h,o-z)
775 include 'DIMENSIONS.ZSCOPT'
776 include "DIMENSIONS.COMPAR"
779 include 'COMMON.LOCAL'
780 include 'COMMON.CHAIN'
781 include 'COMMON.DERIV'
782 include 'COMMON.NAMES'
783 include 'COMMON.INTERACT'
784 include 'COMMON.ENEPS'
785 include 'COMMON.IOUNITS'
786 include 'COMMON.CALC'
787 include 'COMMON.SBRIDGE'
794 eneps_temp(j,i)=0.0d0
797 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
801 c if (icall.gt.0) lprn=.true.
805 if (itypi.eq.ntyp1) cycle
806 itypi1=iabs(itype(i+1))
810 dxi=dc_norm(1,nres+i)
811 dyi=dc_norm(2,nres+i)
812 dzi=dc_norm(3,nres+i)
813 dsci_inv=vbld_inv(i+nres)
815 C Calculate SC interaction energy.
818 do j=istart(i,iint),iend(i,iint)
819 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
820 call dyn_ssbond_ene(i,j,evdwij)
822 write (iout,'(a6,2i5,0pf7.3,a3)')
823 & 'evdw',i,j,evdwij,' ss',evdw
824 C triple bond artifac removal
825 do k=j+1,iend(i,iint)
826 C search over all next residues
827 if (dyn_ss_mask(k)) then
828 C check if they are cysteins
829 C write(iout,*) 'k=',k
830 call triple_ssbond_ene(i,j,k,evdwij)
831 C call the energy function that removes the artifical triple disulfide
832 C bond the soubroutine is located in ssMD.F
834 write (iout,'(a6,2i5,0pf7.3,a3)')
835 & 'evdw',i,j,evdwij,'tss',evdw
841 if (itypj.eq.ntyp1) cycle
842 dscj_inv=vbld_inv(j+nres)
843 sig0ij=sigma(itypi,itypj)
844 chi1=chi(itypi,itypj)
845 chi2=chi(itypj,itypi)
852 alf12=0.5D0*(alf1+alf2)
853 C For diagnostics only!!!
866 dxj=dc_norm(1,nres+j)
867 dyj=dc_norm(2,nres+j)
868 dzj=dc_norm(3,nres+j)
869 c write (iout,*) i,j,xj,yj,zj
870 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
872 C Calculate angle-dependent terms of energy and contributions to their
876 sig=sig0ij*dsqrt(sigsq)
877 rij_shift=1.0D0/rij-sig+sig0ij
878 C I hate to put IF's in the loops, but here don't have another choice!!!!
879 if (rij_shift.le.0.0D0) then
884 c---------------------------------------------------------------
885 rij_shift=1.0D0/rij_shift
887 e1=fac*fac*aa(itypi,itypj)
888 e2=fac*bb(itypi,itypj)
889 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
890 eps2der=evdwij*eps3rt
891 eps3der=evdwij*eps2rt
892 evdwij=evdwij*eps2rt*eps3rt
893 if (bb(itypi,itypj).gt.0) then
898 ij=icant(itypi,itypj)
899 aux=eps1*eps2rt**2*eps3rt**2
900 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
901 & /dabs(eps(itypi,itypj))
902 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
903 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
904 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
905 c & aux*e2/eps(itypi,itypj)
907 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
908 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
910 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
911 & restyp(itypi),i,restyp(itypj),j,
912 & epsi,sigm,chi1,chi2,chip1,chip2,
913 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
914 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
916 write (iout,*) "partial sum", evdw, evdw_t
920 C Calculate gradient components.
921 e1=e1*eps1*eps2rt**2*eps3rt**2
922 fac=-expon*(e1+evdwij)*rij_shift
925 C Calculate the radial part of the gradient
929 C Calculate angular part of the gradient.
938 C-----------------------------------------------------------------------------
939 subroutine egbv(evdw,evdw_t)
941 C This subroutine calculates the interaction energy of nonbonded side chains
942 C assuming the Gay-Berne-Vorobjev potential of interaction.
944 implicit real*8 (a-h,o-z)
946 include 'DIMENSIONS.ZSCOPT'
947 include "DIMENSIONS.COMPAR"
950 include 'COMMON.LOCAL'
951 include 'COMMON.CHAIN'
952 include 'COMMON.DERIV'
953 include 'COMMON.NAMES'
954 include 'COMMON.INTERACT'
955 include 'COMMON.ENEPS'
956 include 'COMMON.IOUNITS'
957 include 'COMMON.CALC'
964 eneps_temp(j,i)=0.0d0
969 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
972 c if (icall.gt.0) lprn=.true.
976 if (itypi.eq.ntyp1) cycle
977 itypi1=iabs(itype(i+1))
981 dxi=dc_norm(1,nres+i)
982 dyi=dc_norm(2,nres+i)
983 dzi=dc_norm(3,nres+i)
984 dsci_inv=vbld_inv(i+nres)
986 C Calculate SC interaction energy.
989 do j=istart(i,iint),iend(i,iint)
992 if (itypj.eq.ntyp1) cycle
993 dscj_inv=vbld_inv(j+nres)
994 sig0ij=sigma(itypi,itypj)
996 chi1=chi(itypi,itypj)
997 chi2=chi(itypj,itypi)
1004 alf12=0.5D0*(alf1+alf2)
1005 C For diagnostics only!!!
1018 dxj=dc_norm(1,nres+j)
1019 dyj=dc_norm(2,nres+j)
1020 dzj=dc_norm(3,nres+j)
1021 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1023 C Calculate angle-dependent terms of energy and contributions to their
1027 sig=sig0ij*dsqrt(sigsq)
1028 rij_shift=1.0D0/rij-sig+r0ij
1029 C I hate to put IF's in the loops, but here don't have another choice!!!!
1030 if (rij_shift.le.0.0D0) then
1035 c---------------------------------------------------------------
1036 rij_shift=1.0D0/rij_shift
1037 fac=rij_shift**expon
1038 e1=fac*fac*aa(itypi,itypj)
1039 e2=fac*bb(itypi,itypj)
1040 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1041 eps2der=evdwij*eps3rt
1042 eps3der=evdwij*eps2rt
1043 fac_augm=rrij**expon
1044 e_augm=augm(itypi,itypj)*fac_augm
1045 evdwij=evdwij*eps2rt*eps3rt
1046 if (bb(itypi,itypj).gt.0.0d0) then
1047 evdw=evdw+evdwij+e_augm
1049 evdw_t=evdw_t+evdwij+e_augm
1051 ij=icant(itypi,itypj)
1052 aux=eps1*eps2rt**2*eps3rt**2
1053 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1054 & /dabs(eps(itypi,itypj))
1055 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1056 c eneps_temp(ij)=eneps_temp(ij)
1057 c & +(evdwij+e_augm)/eps(itypi,itypj)
1059 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1060 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1061 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1062 c & restyp(itypi),i,restyp(itypj),j,
1063 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1064 c & chi1,chi2,chip1,chip2,
1065 c & eps1,eps2rt**2,eps3rt**2,
1066 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1070 C Calculate gradient components.
1071 e1=e1*eps1*eps2rt**2*eps3rt**2
1072 fac=-expon*(e1+evdwij)*rij_shift
1074 fac=rij*fac-2*expon*rrij*e_augm
1075 C Calculate the radial part of the gradient
1079 C Calculate angular part of the gradient.
1087 C-----------------------------------------------------------------------------
1088 subroutine sc_angular
1089 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1090 C om12. Called by ebp, egb, and egbv.
1092 include 'COMMON.CALC'
1096 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1097 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1098 om12=dxi*dxj+dyi*dyj+dzi*dzj
1100 C Calculate eps1(om12) and its derivative in om12
1101 faceps1=1.0D0-om12*chiom12
1102 faceps1_inv=1.0D0/faceps1
1103 eps1=dsqrt(faceps1_inv)
1104 C Following variable is eps1*deps1/dom12
1105 eps1_om12=faceps1_inv*chiom12
1106 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1111 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1112 sigsq=1.0D0-facsig*faceps1_inv
1113 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1114 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1115 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1116 C Calculate eps2 and its derivatives in om1, om2, and om12.
1119 chipom12=chip12*om12
1120 facp=1.0D0-om12*chipom12
1122 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1123 C Following variable is the square root of eps2
1124 eps2rt=1.0D0-facp1*facp_inv
1125 C Following three variables are the derivatives of the square root of eps
1126 C in om1, om2, and om12.
1127 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1128 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1129 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1130 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1131 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1132 C Calculate whole angle-dependent part of epsilon and contributions
1133 C to its derivatives
1136 C----------------------------------------------------------------------------
1138 implicit real*8 (a-h,o-z)
1139 include 'DIMENSIONS'
1140 include 'DIMENSIONS.ZSCOPT'
1141 include 'COMMON.CHAIN'
1142 include 'COMMON.DERIV'
1143 include 'COMMON.CALC'
1144 double precision dcosom1(3),dcosom2(3)
1145 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1146 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1147 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1148 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1150 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1151 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1154 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1157 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1158 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1159 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1160 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1161 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1162 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1165 C Calculate the components of the gradient in DC and X
1169 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1174 c------------------------------------------------------------------------------
1175 subroutine vec_and_deriv
1176 implicit real*8 (a-h,o-z)
1177 include 'DIMENSIONS'
1178 include 'DIMENSIONS.ZSCOPT'
1179 include 'COMMON.IOUNITS'
1180 include 'COMMON.GEO'
1181 include 'COMMON.VAR'
1182 include 'COMMON.LOCAL'
1183 include 'COMMON.CHAIN'
1184 include 'COMMON.VECTORS'
1185 include 'COMMON.DERIV'
1186 include 'COMMON.INTERACT'
1187 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1188 C Compute the local reference systems. For reference system (i), the
1189 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1190 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1192 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1193 if (i.eq.nres-1) then
1194 C Case of the last full residue
1195 C Compute the Z-axis
1196 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1197 costh=dcos(pi-theta(nres))
1198 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1203 C Compute the derivatives of uz
1205 uzder(2,1,1)=-dc_norm(3,i-1)
1206 uzder(3,1,1)= dc_norm(2,i-1)
1207 uzder(1,2,1)= dc_norm(3,i-1)
1209 uzder(3,2,1)=-dc_norm(1,i-1)
1210 uzder(1,3,1)=-dc_norm(2,i-1)
1211 uzder(2,3,1)= dc_norm(1,i-1)
1214 uzder(2,1,2)= dc_norm(3,i)
1215 uzder(3,1,2)=-dc_norm(2,i)
1216 uzder(1,2,2)=-dc_norm(3,i)
1218 uzder(3,2,2)= dc_norm(1,i)
1219 uzder(1,3,2)= dc_norm(2,i)
1220 uzder(2,3,2)=-dc_norm(1,i)
1223 C Compute the Y-axis
1226 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1229 C Compute the derivatives of uy
1232 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1233 & -dc_norm(k,i)*dc_norm(j,i-1)
1234 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1236 uyder(j,j,1)=uyder(j,j,1)-costh
1237 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1242 uygrad(l,k,j,i)=uyder(l,k,j)
1243 uzgrad(l,k,j,i)=uzder(l,k,j)
1247 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1248 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1249 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1250 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1254 C Compute the Z-axis
1255 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1256 costh=dcos(pi-theta(i+2))
1257 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1262 C Compute the derivatives of uz
1264 uzder(2,1,1)=-dc_norm(3,i+1)
1265 uzder(3,1,1)= dc_norm(2,i+1)
1266 uzder(1,2,1)= dc_norm(3,i+1)
1268 uzder(3,2,1)=-dc_norm(1,i+1)
1269 uzder(1,3,1)=-dc_norm(2,i+1)
1270 uzder(2,3,1)= dc_norm(1,i+1)
1273 uzder(2,1,2)= dc_norm(3,i)
1274 uzder(3,1,2)=-dc_norm(2,i)
1275 uzder(1,2,2)=-dc_norm(3,i)
1277 uzder(3,2,2)= dc_norm(1,i)
1278 uzder(1,3,2)= dc_norm(2,i)
1279 uzder(2,3,2)=-dc_norm(1,i)
1282 C Compute the Y-axis
1285 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1288 C Compute the derivatives of uy
1291 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1292 & -dc_norm(k,i)*dc_norm(j,i+1)
1293 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1295 uyder(j,j,1)=uyder(j,j,1)-costh
1296 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1301 uygrad(l,k,j,i)=uyder(l,k,j)
1302 uzgrad(l,k,j,i)=uzder(l,k,j)
1306 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1307 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1308 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1309 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1315 vbld_inv_temp(1)=vbld_inv(i+1)
1316 if (i.lt.nres-1) then
1317 vbld_inv_temp(2)=vbld_inv(i+2)
1319 vbld_inv_temp(2)=vbld_inv(i)
1324 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1325 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1333 C-----------------------------------------------------------------------------
1334 subroutine vec_and_deriv_test
1335 implicit real*8 (a-h,o-z)
1336 include 'DIMENSIONS'
1337 include 'DIMENSIONS.ZSCOPT'
1338 include 'COMMON.IOUNITS'
1339 include 'COMMON.GEO'
1340 include 'COMMON.VAR'
1341 include 'COMMON.LOCAL'
1342 include 'COMMON.CHAIN'
1343 include 'COMMON.VECTORS'
1344 dimension uyder(3,3,2),uzder(3,3,2)
1345 C Compute the local reference systems. For reference system (i), the
1346 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1347 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1349 if (i.eq.nres-1) then
1350 C Case of the last full residue
1351 C Compute the Z-axis
1352 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1353 costh=dcos(pi-theta(nres))
1354 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1355 c write (iout,*) 'fac',fac,
1356 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1357 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1361 C Compute the derivatives of uz
1363 uzder(2,1,1)=-dc_norm(3,i-1)
1364 uzder(3,1,1)= dc_norm(2,i-1)
1365 uzder(1,2,1)= dc_norm(3,i-1)
1367 uzder(3,2,1)=-dc_norm(1,i-1)
1368 uzder(1,3,1)=-dc_norm(2,i-1)
1369 uzder(2,3,1)= dc_norm(1,i-1)
1372 uzder(2,1,2)= dc_norm(3,i)
1373 uzder(3,1,2)=-dc_norm(2,i)
1374 uzder(1,2,2)=-dc_norm(3,i)
1376 uzder(3,2,2)= dc_norm(1,i)
1377 uzder(1,3,2)= dc_norm(2,i)
1378 uzder(2,3,2)=-dc_norm(1,i)
1380 C Compute the Y-axis
1382 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1385 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1386 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1387 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1389 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1392 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1393 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1396 c write (iout,*) 'facy',facy,
1397 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1398 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1400 uy(k,i)=facy*uy(k,i)
1402 C Compute the derivatives of uy
1405 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1406 & -dc_norm(k,i)*dc_norm(j,i-1)
1407 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1409 c uyder(j,j,1)=uyder(j,j,1)-costh
1410 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1411 uyder(j,j,1)=uyder(j,j,1)
1412 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1413 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1419 uygrad(l,k,j,i)=uyder(l,k,j)
1420 uzgrad(l,k,j,i)=uzder(l,k,j)
1424 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1425 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1426 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1427 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1430 C Compute the Z-axis
1431 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1432 costh=dcos(pi-theta(i+2))
1433 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1434 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1438 C Compute the derivatives of uz
1440 uzder(2,1,1)=-dc_norm(3,i+1)
1441 uzder(3,1,1)= dc_norm(2,i+1)
1442 uzder(1,2,1)= dc_norm(3,i+1)
1444 uzder(3,2,1)=-dc_norm(1,i+1)
1445 uzder(1,3,1)=-dc_norm(2,i+1)
1446 uzder(2,3,1)= dc_norm(1,i+1)
1449 uzder(2,1,2)= dc_norm(3,i)
1450 uzder(3,1,2)=-dc_norm(2,i)
1451 uzder(1,2,2)=-dc_norm(3,i)
1453 uzder(3,2,2)= dc_norm(1,i)
1454 uzder(1,3,2)= dc_norm(2,i)
1455 uzder(2,3,2)=-dc_norm(1,i)
1457 C Compute the Y-axis
1459 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1460 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1461 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1463 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1466 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1467 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1470 c write (iout,*) 'facy',facy,
1471 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1472 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1474 uy(k,i)=facy*uy(k,i)
1476 C Compute the derivatives of uy
1479 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1480 & -dc_norm(k,i)*dc_norm(j,i+1)
1481 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1483 c uyder(j,j,1)=uyder(j,j,1)-costh
1484 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1485 uyder(j,j,1)=uyder(j,j,1)
1486 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1487 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1493 uygrad(l,k,j,i)=uyder(l,k,j)
1494 uzgrad(l,k,j,i)=uzder(l,k,j)
1498 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1499 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1500 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1501 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1508 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1509 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1516 C-----------------------------------------------------------------------------
1517 subroutine check_vecgrad
1518 implicit real*8 (a-h,o-z)
1519 include 'DIMENSIONS'
1520 include 'DIMENSIONS.ZSCOPT'
1521 include 'COMMON.IOUNITS'
1522 include 'COMMON.GEO'
1523 include 'COMMON.VAR'
1524 include 'COMMON.LOCAL'
1525 include 'COMMON.CHAIN'
1526 include 'COMMON.VECTORS'
1527 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1528 dimension uyt(3,maxres),uzt(3,maxres)
1529 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1530 double precision delta /1.0d-7/
1533 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1534 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1535 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1536 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1537 cd & (dc_norm(if90,i),if90=1,3)
1538 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1539 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1540 cd write(iout,'(a)')
1546 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1547 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1560 cd write (iout,*) 'i=',i
1562 erij(k)=dc_norm(k,i)
1566 dc_norm(k,i)=erij(k)
1568 dc_norm(j,i)=dc_norm(j,i)+delta
1569 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1571 c dc_norm(k,i)=dc_norm(k,i)/fac
1573 c write (iout,*) (dc_norm(k,i),k=1,3)
1574 c write (iout,*) (erij(k),k=1,3)
1577 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1578 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1579 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1580 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1582 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1583 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1584 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1587 dc_norm(k,i)=erij(k)
1590 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1591 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1592 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1593 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1594 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1595 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1596 cd write (iout,'(a)')
1601 C--------------------------------------------------------------------------
1602 subroutine set_matrices
1603 implicit real*8 (a-h,o-z)
1604 include 'DIMENSIONS'
1605 include 'DIMENSIONS.ZSCOPT'
1606 include 'COMMON.IOUNITS'
1607 include 'COMMON.GEO'
1608 include 'COMMON.VAR'
1609 include 'COMMON.LOCAL'
1610 include 'COMMON.CHAIN'
1611 include 'COMMON.DERIV'
1612 include 'COMMON.INTERACT'
1613 include 'COMMON.CONTACTS'
1614 include 'COMMON.TORSION'
1615 include 'COMMON.VECTORS'
1616 include 'COMMON.FFIELD'
1617 double precision auxvec(2),auxmat(2,2)
1619 C Compute the virtual-bond-torsional-angle dependent quantities needed
1620 C to calculate the el-loc multibody terms of various order.
1623 if (i .lt. nres+1) then
1660 if (i .gt. 3 .and. i .lt. nres+1) then
1661 obrot_der(1,i-2)=-sin1
1662 obrot_der(2,i-2)= cos1
1663 Ugder(1,1,i-2)= sin1
1664 Ugder(1,2,i-2)=-cos1
1665 Ugder(2,1,i-2)=-cos1
1666 Ugder(2,2,i-2)=-sin1
1669 obrot2_der(1,i-2)=-dwasin2
1670 obrot2_der(2,i-2)= dwacos2
1671 Ug2der(1,1,i-2)= dwasin2
1672 Ug2der(1,2,i-2)=-dwacos2
1673 Ug2der(2,1,i-2)=-dwacos2
1674 Ug2der(2,2,i-2)=-dwasin2
1676 obrot_der(1,i-2)=0.0d0
1677 obrot_der(2,i-2)=0.0d0
1678 Ugder(1,1,i-2)=0.0d0
1679 Ugder(1,2,i-2)=0.0d0
1680 Ugder(2,1,i-2)=0.0d0
1681 Ugder(2,2,i-2)=0.0d0
1682 obrot2_der(1,i-2)=0.0d0
1683 obrot2_der(2,i-2)=0.0d0
1684 Ug2der(1,1,i-2)=0.0d0
1685 Ug2der(1,2,i-2)=0.0d0
1686 Ug2der(2,1,i-2)=0.0d0
1687 Ug2der(2,2,i-2)=0.0d0
1689 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1690 if (itype(i-2).le.ntyp) then
1691 iti = itortyp(itype(i-2))
1698 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1699 if (itype(i-1).le.ntyp) then
1700 iti1 = itortyp(itype(i-1))
1707 cd write (iout,*) '*******i',i,' iti1',iti
1708 cd write (iout,*) 'b1',b1(:,iti)
1709 cd write (iout,*) 'b2',b2(:,iti)
1710 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1711 c print *,"itilde1 i iti iti1",i,iti,iti1
1712 if (i .gt. iatel_s+2) then
1713 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1714 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1715 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1716 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1717 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1718 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1719 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1729 DtUg2(l,k,i-2)=0.0d0
1733 c print *,"itilde2 i iti iti1",i,iti,iti1
1734 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1735 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1736 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1737 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1738 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1739 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1740 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1741 c print *,"itilde3 i iti iti1",i,iti,iti1
1743 muder(k,i-2)=Ub2der(k,i-2)
1745 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1746 if (itype(i-1).le.ntyp) then
1747 iti1 = itortyp(itype(i-1))
1755 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1757 C Vectors and matrices dependent on a single virtual-bond dihedral.
1758 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1759 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1760 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1761 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1762 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1763 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1764 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1765 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1766 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1767 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1768 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1770 C Matrices dependent on two consecutive virtual-bond dihedrals.
1771 C The order of matrices is from left to right.
1773 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1774 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1775 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1776 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1777 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1778 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1779 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1780 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1783 cd iti = itortyp(itype(i))
1786 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1787 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1792 C--------------------------------------------------------------------------
1793 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1795 C This subroutine calculates the average interaction energy and its gradient
1796 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1797 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1798 C The potential depends both on the distance of peptide-group centers and on
1799 C the orientation of the CA-CA virtual bonds.
1801 implicit real*8 (a-h,o-z)
1802 include 'DIMENSIONS'
1803 include 'DIMENSIONS.ZSCOPT'
1804 include 'COMMON.CONTROL'
1805 include 'COMMON.IOUNITS'
1806 include 'COMMON.GEO'
1807 include 'COMMON.VAR'
1808 include 'COMMON.LOCAL'
1809 include 'COMMON.CHAIN'
1810 include 'COMMON.DERIV'
1811 include 'COMMON.INTERACT'
1812 include 'COMMON.CONTACTS'
1813 include 'COMMON.TORSION'
1814 include 'COMMON.VECTORS'
1815 include 'COMMON.FFIELD'
1816 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1817 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1818 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1819 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1820 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1821 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1822 double precision scal_el /0.5d0/
1824 C 13-go grudnia roku pamietnego...
1825 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1826 & 0.0d0,1.0d0,0.0d0,
1827 & 0.0d0,0.0d0,1.0d0/
1828 cd write(iout,*) 'In EELEC'
1830 cd write(iout,*) 'Type',i
1831 cd write(iout,*) 'B1',B1(:,i)
1832 cd write(iout,*) 'B2',B2(:,i)
1833 cd write(iout,*) 'CC',CC(:,:,i)
1834 cd write(iout,*) 'DD',DD(:,:,i)
1835 cd write(iout,*) 'EE',EE(:,:,i)
1837 cd call check_vecgrad
1839 if (icheckgrad.eq.1) then
1841 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1843 dc_norm(k,i)=dc(k,i)*fac
1845 c write (iout,*) 'i',i,' fac',fac
1848 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1849 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1850 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1851 cd if (wel_loc.gt.0.0d0) then
1852 if (icheckgrad.eq.1) then
1853 call vec_and_deriv_test
1860 cd write (iout,*) 'i=',i
1862 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1865 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1866 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1879 cd print '(a)','Enter EELEC'
1880 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1882 gel_loc_loc(i)=0.0d0
1885 do i=iatel_s,iatel_e
1886 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1887 if (itel(i).eq.0) goto 1215
1891 dx_normi=dc_norm(1,i)
1892 dy_normi=dc_norm(2,i)
1893 dz_normi=dc_norm(3,i)
1894 xmedi=c(1,i)+0.5d0*dxi
1895 ymedi=c(2,i)+0.5d0*dyi
1896 zmedi=c(3,i)+0.5d0*dzi
1898 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1899 do j=ielstart(i),ielend(i)
1900 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1901 if (itel(j).eq.0) goto 1216
1905 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1906 aaa=app(iteli,itelj)
1907 bbb=bpp(iteli,itelj)
1908 C Diagnostics only!!!
1914 ael6i=ael6(iteli,itelj)
1915 ael3i=ael3(iteli,itelj)
1919 dx_normj=dc_norm(1,j)
1920 dy_normj=dc_norm(2,j)
1921 dz_normj=dc_norm(3,j)
1922 xj=c(1,j)+0.5D0*dxj-xmedi
1923 yj=c(2,j)+0.5D0*dyj-ymedi
1924 zj=c(3,j)+0.5D0*dzj-zmedi
1925 rij=xj*xj+yj*yj+zj*zj
1931 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1932 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1933 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1934 fac=cosa-3.0D0*cosb*cosg
1936 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1937 if (j.eq.i+2) ev1=scal_el*ev1
1942 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1945 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1946 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1947 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1950 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
1951 c &'evdw1',i,j,evdwij
1952 c &,iteli,itelj,aaa,evdw1
1954 c write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
1955 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1956 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1957 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1958 c & xmedi,ymedi,zmedi,xj,yj,zj
1960 C Calculate contributions to the Cartesian gradient.
1963 facvdw=-6*rrmij*(ev1+evdwij)
1964 facel=-3*rrmij*(el1+eesij)
1971 * Radial derivatives. First process both termini of the fragment (i,j)
1978 gelc(k,i)=gelc(k,i)+ghalf
1979 gelc(k,j)=gelc(k,j)+ghalf
1982 * Loop over residues i+1 thru j-1.
1986 gelc(l,k)=gelc(l,k)+ggg(l)
1994 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1995 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1998 * Loop over residues i+1 thru j-1.
2002 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2009 fac=-3*rrmij*(facvdw+facvdw+facel)
2015 * Radial derivatives. First process both termini of the fragment (i,j)
2022 gelc(k,i)=gelc(k,i)+ghalf
2023 gelc(k,j)=gelc(k,j)+ghalf
2026 * Loop over residues i+1 thru j-1.
2030 gelc(l,k)=gelc(l,k)+ggg(l)
2037 ecosa=2.0D0*fac3*fac1+fac4
2040 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2041 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2043 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2044 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2046 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2047 cd & (dcosg(k),k=1,3)
2049 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2053 gelc(k,i)=gelc(k,i)+ghalf
2054 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2055 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2056 gelc(k,j)=gelc(k,j)+ghalf
2057 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2058 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2062 gelc(l,k)=gelc(l,k)+ggg(l)
2067 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2068 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2069 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2071 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2072 C energy of a peptide unit is assumed in the form of a second-order
2073 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2074 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2075 C are computed for EVERY pair of non-contiguous peptide groups.
2077 if (j.lt.nres-1) then
2088 muij(kkk)=mu(k,i)*mu(l,j)
2091 cd write (iout,*) 'EELEC: i',i,' j',j
2092 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2093 cd write(iout,*) 'muij',muij
2094 ury=scalar(uy(1,i),erij)
2095 urz=scalar(uz(1,i),erij)
2096 vry=scalar(uy(1,j),erij)
2097 vrz=scalar(uz(1,j),erij)
2098 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2099 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2100 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2101 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2102 C For diagnostics only
2107 fac=dsqrt(-ael6i)*r3ij
2108 cd write (2,*) 'fac=',fac
2109 C For diagnostics only
2115 cd write (iout,'(4i5,4f10.5)')
2116 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2117 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2118 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2119 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2120 cd write (iout,'(4f10.5)')
2121 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2122 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2123 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2124 cd write (iout,'(2i3,9f10.5/)') i,j,
2125 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2127 C Derivatives of the elements of A in virtual-bond vectors
2128 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2135 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2136 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2137 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2138 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2139 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2140 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2141 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2142 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2143 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2144 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2145 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2146 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2156 C Compute radial contributions to the gradient
2178 C Add the contributions coming from er
2181 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2182 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2183 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2184 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2187 C Derivatives in DC(i)
2188 ghalf1=0.5d0*agg(k,1)
2189 ghalf2=0.5d0*agg(k,2)
2190 ghalf3=0.5d0*agg(k,3)
2191 ghalf4=0.5d0*agg(k,4)
2192 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2193 & -3.0d0*uryg(k,2)*vry)+ghalf1
2194 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2195 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2196 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2197 & -3.0d0*urzg(k,2)*vry)+ghalf3
2198 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2199 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2200 C Derivatives in DC(i+1)
2201 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2202 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2203 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2204 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2205 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2206 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2207 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2208 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2209 C Derivatives in DC(j)
2210 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2211 & -3.0d0*vryg(k,2)*ury)+ghalf1
2212 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2213 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2214 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2215 & -3.0d0*vryg(k,2)*urz)+ghalf3
2216 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2217 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2218 C Derivatives in DC(j+1) or DC(nres-1)
2219 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2220 & -3.0d0*vryg(k,3)*ury)
2221 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2222 & -3.0d0*vrzg(k,3)*ury)
2223 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2224 & -3.0d0*vryg(k,3)*urz)
2225 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2226 & -3.0d0*vrzg(k,3)*urz)
2231 C Derivatives in DC(i+1)
2232 cd aggi1(k,1)=agg(k,1)
2233 cd aggi1(k,2)=agg(k,2)
2234 cd aggi1(k,3)=agg(k,3)
2235 cd aggi1(k,4)=agg(k,4)
2236 C Derivatives in DC(j)
2241 C Derivatives in DC(j+1)
2246 if (j.eq.nres-1 .and. i.lt.j-2) then
2248 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2249 cd aggj1(k,l)=agg(k,l)
2255 C Check the loc-el terms by numerical integration
2265 aggi(k,l)=-aggi(k,l)
2266 aggi1(k,l)=-aggi1(k,l)
2267 aggj(k,l)=-aggj(k,l)
2268 aggj1(k,l)=-aggj1(k,l)
2271 if (j.lt.nres-1) then
2277 aggi(k,l)=-aggi(k,l)
2278 aggi1(k,l)=-aggi1(k,l)
2279 aggj(k,l)=-aggj(k,l)
2280 aggj1(k,l)=-aggj1(k,l)
2291 aggi(k,l)=-aggi(k,l)
2292 aggi1(k,l)=-aggi1(k,l)
2293 aggj(k,l)=-aggj(k,l)
2294 aggj1(k,l)=-aggj1(k,l)
2300 IF (wel_loc.gt.0.0d0) THEN
2301 C Contribution to the local-electrostatic energy coming from the i-j pair
2302 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2304 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2305 c write (iout,'(a6,2i5,0pf7.3)')
2306 c & 'eelloc',i,j,eel_loc_ij
2307 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2308 eel_loc=eel_loc+eel_loc_ij
2309 C Partial derivatives in virtual-bond dihedral angles gamma
2312 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2313 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2314 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2315 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2316 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2317 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2318 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2319 cd write(iout,*) 'agg ',agg
2320 cd write(iout,*) 'aggi ',aggi
2321 cd write(iout,*) 'aggi1',aggi1
2322 cd write(iout,*) 'aggj ',aggj
2323 cd write(iout,*) 'aggj1',aggj1
2325 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2327 ggg(l)=agg(l,1)*muij(1)+
2328 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2332 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2335 C Remaining derivatives of eello
2337 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2338 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2339 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2340 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2341 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2342 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2343 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2344 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2348 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2349 C Contributions from turns
2354 call eturn34(i,j,eello_turn3,eello_turn4)
2356 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2357 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2359 C Calculate the contact function. The ith column of the array JCONT will
2360 C contain the numbers of atoms that make contacts with the atom I (of numbers
2361 C greater than I). The arrays FACONT and GACONT will contain the values of
2362 C the contact function and its derivative.
2363 c r0ij=1.02D0*rpp(iteli,itelj)
2364 c r0ij=1.11D0*rpp(iteli,itelj)
2365 r0ij=2.20D0*rpp(iteli,itelj)
2366 c r0ij=1.55D0*rpp(iteli,itelj)
2367 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2368 if (fcont.gt.0.0D0) then
2369 num_conti=num_conti+1
2370 if (num_conti.gt.maxconts) then
2371 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2372 & ' will skip next contacts for this conf.'
2374 jcont_hb(num_conti,i)=j
2375 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2376 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2377 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2379 d_cont(num_conti,i)=rij
2380 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2381 C --- Electrostatic-interaction matrix ---
2382 a_chuj(1,1,num_conti,i)=a22
2383 a_chuj(1,2,num_conti,i)=a23
2384 a_chuj(2,1,num_conti,i)=a32
2385 a_chuj(2,2,num_conti,i)=a33
2386 C --- Gradient of rij
2388 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2391 c a_chuj(1,1,num_conti,i)=-0.61d0
2392 c a_chuj(1,2,num_conti,i)= 0.4d0
2393 c a_chuj(2,1,num_conti,i)= 0.65d0
2394 c a_chuj(2,2,num_conti,i)= 0.50d0
2395 c else if (i.eq.2) then
2396 c a_chuj(1,1,num_conti,i)= 0.0d0
2397 c a_chuj(1,2,num_conti,i)= 0.0d0
2398 c a_chuj(2,1,num_conti,i)= 0.0d0
2399 c a_chuj(2,2,num_conti,i)= 0.0d0
2401 C --- and its gradients
2402 cd write (iout,*) 'i',i,' j',j
2404 cd write (iout,*) 'iii 1 kkk',kkk
2405 cd write (iout,*) agg(kkk,:)
2408 cd write (iout,*) 'iii 2 kkk',kkk
2409 cd write (iout,*) aggi(kkk,:)
2412 cd write (iout,*) 'iii 3 kkk',kkk
2413 cd write (iout,*) aggi1(kkk,:)
2416 cd write (iout,*) 'iii 4 kkk',kkk
2417 cd write (iout,*) aggj(kkk,:)
2420 cd write (iout,*) 'iii 5 kkk',kkk
2421 cd write (iout,*) aggj1(kkk,:)
2428 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2429 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2430 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2431 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2432 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2434 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2440 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2441 C Calculate contact energies
2443 wij=cosa-3.0D0*cosb*cosg
2446 c fac3=dsqrt(-ael6i)/r0ij**3
2447 fac3=dsqrt(-ael6i)*r3ij
2448 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2449 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2451 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2452 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2453 C Diagnostics. Comment out or remove after debugging!
2454 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2455 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2456 c ees0m(num_conti,i)=0.0D0
2458 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2459 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2460 facont_hb(num_conti,i)=fcont
2462 C Angular derivatives of the contact function
2463 ees0pij1=fac3/ees0pij
2464 ees0mij1=fac3/ees0mij
2465 fac3p=-3.0D0*fac3*rrmij
2466 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2467 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2469 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2470 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2471 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2472 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2473 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2474 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2475 ecosap=ecosa1+ecosa2
2476 ecosbp=ecosb1+ecosb2
2477 ecosgp=ecosg1+ecosg2
2478 ecosam=ecosa1-ecosa2
2479 ecosbm=ecosb1-ecosb2
2480 ecosgm=ecosg1-ecosg2
2489 fprimcont=fprimcont/rij
2490 cd facont_hb(num_conti,i)=1.0D0
2491 C Following line is for diagnostics.
2494 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2495 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2498 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2499 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2501 gggp(1)=gggp(1)+ees0pijp*xj
2502 gggp(2)=gggp(2)+ees0pijp*yj
2503 gggp(3)=gggp(3)+ees0pijp*zj
2504 gggm(1)=gggm(1)+ees0mijp*xj
2505 gggm(2)=gggm(2)+ees0mijp*yj
2506 gggm(3)=gggm(3)+ees0mijp*zj
2507 C Derivatives due to the contact function
2508 gacont_hbr(1,num_conti,i)=fprimcont*xj
2509 gacont_hbr(2,num_conti,i)=fprimcont*yj
2510 gacont_hbr(3,num_conti,i)=fprimcont*zj
2512 ghalfp=0.5D0*gggp(k)
2513 ghalfm=0.5D0*gggm(k)
2514 gacontp_hb1(k,num_conti,i)=ghalfp
2515 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2516 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2517 gacontp_hb2(k,num_conti,i)=ghalfp
2518 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2519 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2520 gacontp_hb3(k,num_conti,i)=gggp(k)
2521 gacontm_hb1(k,num_conti,i)=ghalfm
2522 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2523 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2524 gacontm_hb2(k,num_conti,i)=ghalfm
2525 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2526 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2527 gacontm_hb3(k,num_conti,i)=gggm(k)
2530 C Diagnostics. Comment out or remove after debugging!
2532 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2533 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2534 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2535 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2536 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2537 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2540 endif ! num_conti.le.maxconts
2545 num_cont_hb(i)=num_conti
2549 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2550 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2552 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2553 ccc eel_loc=eel_loc+eello_turn3
2556 C-----------------------------------------------------------------------------
2557 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2558 C Third- and fourth-order contributions from turns
2559 implicit real*8 (a-h,o-z)
2560 include 'DIMENSIONS'
2561 include 'DIMENSIONS.ZSCOPT'
2562 include 'COMMON.IOUNITS'
2563 include 'COMMON.GEO'
2564 include 'COMMON.VAR'
2565 include 'COMMON.LOCAL'
2566 include 'COMMON.CHAIN'
2567 include 'COMMON.DERIV'
2568 include 'COMMON.INTERACT'
2569 include 'COMMON.CONTACTS'
2570 include 'COMMON.TORSION'
2571 include 'COMMON.VECTORS'
2572 include 'COMMON.FFIELD'
2574 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2575 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2576 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2577 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2578 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2579 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2581 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2583 C Third-order contributions
2590 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2591 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2592 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2593 call transpose2(auxmat(1,1),auxmat1(1,1))
2594 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2595 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2596 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2597 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2598 cd & ' eello_turn3_num',4*eello_turn3_num
2600 C Derivatives in gamma(i)
2601 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2602 call transpose2(auxmat2(1,1),pizda(1,1))
2603 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2604 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2605 C Derivatives in gamma(i+1)
2606 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2607 call transpose2(auxmat2(1,1),pizda(1,1))
2608 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2609 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2610 & +0.5d0*(pizda(1,1)+pizda(2,2))
2611 C Cartesian derivatives
2613 a_temp(1,1)=aggi(l,1)
2614 a_temp(1,2)=aggi(l,2)
2615 a_temp(2,1)=aggi(l,3)
2616 a_temp(2,2)=aggi(l,4)
2617 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2618 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2619 & +0.5d0*(pizda(1,1)+pizda(2,2))
2620 a_temp(1,1)=aggi1(l,1)
2621 a_temp(1,2)=aggi1(l,2)
2622 a_temp(2,1)=aggi1(l,3)
2623 a_temp(2,2)=aggi1(l,4)
2624 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2625 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2626 & +0.5d0*(pizda(1,1)+pizda(2,2))
2627 a_temp(1,1)=aggj(l,1)
2628 a_temp(1,2)=aggj(l,2)
2629 a_temp(2,1)=aggj(l,3)
2630 a_temp(2,2)=aggj(l,4)
2631 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2632 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2633 & +0.5d0*(pizda(1,1)+pizda(2,2))
2634 a_temp(1,1)=aggj1(l,1)
2635 a_temp(1,2)=aggj1(l,2)
2636 a_temp(2,1)=aggj1(l,3)
2637 a_temp(2,2)=aggj1(l,4)
2638 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2639 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2640 & +0.5d0*(pizda(1,1)+pizda(2,2))
2643 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2644 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2646 C Fourth-order contributions
2654 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2655 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2656 iti1=itortyp(itype(i+1))
2657 iti2=itortyp(itype(i+2))
2658 iti3=itortyp(itype(i+3))
2659 call transpose2(EUg(1,1,i+1),e1t(1,1))
2660 call transpose2(Eug(1,1,i+2),e2t(1,1))
2661 call transpose2(Eug(1,1,i+3),e3t(1,1))
2662 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2663 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2664 s1=scalar2(b1(1,iti2),auxvec(1))
2665 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2666 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2667 s2=scalar2(b1(1,iti1),auxvec(1))
2668 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2669 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2670 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2671 eello_turn4=eello_turn4-(s1+s2+s3)
2672 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2673 cd & ' eello_turn4_num',8*eello_turn4_num
2674 C Derivatives in gamma(i)
2676 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2677 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2678 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2679 s1=scalar2(b1(1,iti2),auxvec(1))
2680 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2681 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2682 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2683 C Derivatives in gamma(i+1)
2684 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2685 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2686 s2=scalar2(b1(1,iti1),auxvec(1))
2687 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2688 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2689 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2690 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2691 C Derivatives in gamma(i+2)
2692 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2693 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2694 s1=scalar2(b1(1,iti2),auxvec(1))
2695 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2696 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2697 s2=scalar2(b1(1,iti1),auxvec(1))
2698 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2699 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2700 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2701 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2702 C Cartesian derivatives
2703 C Derivatives of this turn contributions in DC(i+2)
2704 if (j.lt.nres-1) then
2706 a_temp(1,1)=agg(l,1)
2707 a_temp(1,2)=agg(l,2)
2708 a_temp(2,1)=agg(l,3)
2709 a_temp(2,2)=agg(l,4)
2710 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2711 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2712 s1=scalar2(b1(1,iti2),auxvec(1))
2713 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2714 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2715 s2=scalar2(b1(1,iti1),auxvec(1))
2716 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2717 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2718 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2720 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2723 C Remaining derivatives of this turn contribution
2725 a_temp(1,1)=aggi(l,1)
2726 a_temp(1,2)=aggi(l,2)
2727 a_temp(2,1)=aggi(l,3)
2728 a_temp(2,2)=aggi(l,4)
2729 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2730 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2731 s1=scalar2(b1(1,iti2),auxvec(1))
2732 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2733 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2734 s2=scalar2(b1(1,iti1),auxvec(1))
2735 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2736 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2737 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2738 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2739 a_temp(1,1)=aggi1(l,1)
2740 a_temp(1,2)=aggi1(l,2)
2741 a_temp(2,1)=aggi1(l,3)
2742 a_temp(2,2)=aggi1(l,4)
2743 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2744 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2745 s1=scalar2(b1(1,iti2),auxvec(1))
2746 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2747 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2748 s2=scalar2(b1(1,iti1),auxvec(1))
2749 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2750 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2751 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2752 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2753 a_temp(1,1)=aggj(l,1)
2754 a_temp(1,2)=aggj(l,2)
2755 a_temp(2,1)=aggj(l,3)
2756 a_temp(2,2)=aggj(l,4)
2757 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2758 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2759 s1=scalar2(b1(1,iti2),auxvec(1))
2760 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2761 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2762 s2=scalar2(b1(1,iti1),auxvec(1))
2763 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2764 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2765 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2766 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2767 a_temp(1,1)=aggj1(l,1)
2768 a_temp(1,2)=aggj1(l,2)
2769 a_temp(2,1)=aggj1(l,3)
2770 a_temp(2,2)=aggj1(l,4)
2771 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2772 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2773 s1=scalar2(b1(1,iti2),auxvec(1))
2774 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2775 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2776 s2=scalar2(b1(1,iti1),auxvec(1))
2777 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2778 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2779 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2780 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2786 C-----------------------------------------------------------------------------
2787 subroutine vecpr(u,v,w)
2788 implicit real*8(a-h,o-z)
2789 dimension u(3),v(3),w(3)
2790 w(1)=u(2)*v(3)-u(3)*v(2)
2791 w(2)=-u(1)*v(3)+u(3)*v(1)
2792 w(3)=u(1)*v(2)-u(2)*v(1)
2795 C-----------------------------------------------------------------------------
2796 subroutine unormderiv(u,ugrad,unorm,ungrad)
2797 C This subroutine computes the derivatives of a normalized vector u, given
2798 C the derivatives computed without normalization conditions, ugrad. Returns
2801 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2802 double precision vec(3)
2803 double precision scalar
2805 c write (2,*) 'ugrad',ugrad
2808 vec(i)=scalar(ugrad(1,i),u(1))
2810 c write (2,*) 'vec',vec
2813 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2816 c write (2,*) 'ungrad',ungrad
2819 C-----------------------------------------------------------------------------
2820 subroutine escp(evdw2,evdw2_14)
2822 C This subroutine calculates the excluded-volume interaction energy between
2823 C peptide-group centers and side chains and its gradient in virtual-bond and
2824 C side-chain vectors.
2826 implicit real*8 (a-h,o-z)
2827 include 'DIMENSIONS'
2828 include 'DIMENSIONS.ZSCOPT'
2829 include 'COMMON.GEO'
2830 include 'COMMON.VAR'
2831 include 'COMMON.LOCAL'
2832 include 'COMMON.CHAIN'
2833 include 'COMMON.DERIV'
2834 include 'COMMON.INTERACT'
2835 include 'COMMON.FFIELD'
2836 include 'COMMON.IOUNITS'
2840 cd print '(a)','Enter ESCP'
2841 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2842 c & ' scal14',scal14
2843 do i=iatscp_s,iatscp_e
2844 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2846 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2847 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2848 if (iteli.eq.0) goto 1225
2849 xi=0.5D0*(c(1,i)+c(1,i+1))
2850 yi=0.5D0*(c(2,i)+c(2,i+1))
2851 zi=0.5D0*(c(3,i)+c(3,i+1))
2853 do iint=1,nscp_gr(i)
2855 do j=iscpstart(i,iint),iscpend(i,iint)
2856 itypj=iabs(itype(j))
2857 if (itypj.eq.ntyp1) cycle
2858 C Uncomment following three lines for SC-p interactions
2862 C Uncomment following three lines for Ca-p interactions
2866 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2868 e1=fac*fac*aad(itypj,iteli)
2869 e2=fac*bad(itypj,iteli)
2870 if (iabs(j-i) .le. 2) then
2873 evdw2_14=evdw2_14+e1+e2
2876 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
2877 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
2878 c & bad(itypj,iteli)
2882 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2884 fac=-(evdwij+e1)*rrij
2889 cd write (iout,*) 'j<i'
2890 C Uncomment following three lines for SC-p interactions
2892 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2895 cd write (iout,*) 'j>i'
2898 C Uncomment following line for SC-p interactions
2899 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2903 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2907 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2908 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2911 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2921 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2922 gradx_scp(j,i)=expon*gradx_scp(j,i)
2925 C******************************************************************************
2929 C To save time the factor EXPON has been extracted from ALL components
2930 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2933 C******************************************************************************
2936 C--------------------------------------------------------------------------
2937 subroutine edis(ehpb)
2939 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2941 implicit real*8 (a-h,o-z)
2942 include 'DIMENSIONS'
2943 include 'DIMENSIONS.ZSCOPT'
2944 include 'COMMON.SBRIDGE'
2945 include 'COMMON.CHAIN'
2946 include 'COMMON.DERIV'
2947 include 'COMMON.VAR'
2948 include 'COMMON.INTERACT'
2951 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2952 cd print *,'link_start=',link_start,' link_end=',link_end
2953 if (link_end.eq.0) return
2954 do i=link_start,link_end
2955 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2956 C CA-CA distance used in regularization of structure.
2959 C iii and jjj point to the residues for which the distance is assigned.
2960 if (ii.gt.nres) then
2967 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2968 C distance and angle dependent SS bond potential.
2969 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2970 C & iabs(itype(jjj)).eq.1) then
2972 if (.not.dyn_ss .and. i.le.nss) then
2973 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2974 & iabs(itype(jjj)).eq.1) then
2975 call ssbond_ene(iii,jjj,eij)
2979 C Calculate the distance between the two points and its difference from the
2983 C Get the force constant corresponding to this distance.
2985 C Calculate the contribution to energy.
2986 ehpb=ehpb+waga*rdis*rdis
2988 C Evaluate gradient.
2991 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2992 cd & ' waga=',waga,' fac=',fac
2994 ggg(j)=fac*(c(j,jj)-c(j,ii))
2996 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2997 C If this is a SC-SC distance, we need to calculate the contributions to the
2998 C Cartesian gradient in the SC vectors (ghpbx).
3001 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3002 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3007 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3015 C--------------------------------------------------------------------------
3016 subroutine ssbond_ene(i,j,eij)
3018 C Calculate the distance and angle dependent SS-bond potential energy
3019 C using a free-energy function derived based on RHF/6-31G** ab initio
3020 C calculations of diethyl disulfide.
3022 C A. Liwo and U. Kozlowska, 11/24/03
3024 implicit real*8 (a-h,o-z)
3025 include 'DIMENSIONS'
3026 include 'DIMENSIONS.ZSCOPT'
3027 include 'COMMON.SBRIDGE'
3028 include 'COMMON.CHAIN'
3029 include 'COMMON.DERIV'
3030 include 'COMMON.LOCAL'
3031 include 'COMMON.INTERACT'
3032 include 'COMMON.VAR'
3033 include 'COMMON.IOUNITS'
3034 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3035 itypi=iabs(itype(i))
3039 dxi=dc_norm(1,nres+i)
3040 dyi=dc_norm(2,nres+i)
3041 dzi=dc_norm(3,nres+i)
3042 dsci_inv=dsc_inv(itypi)
3043 itypj=iabs(itype(j))
3044 dscj_inv=dsc_inv(itypj)
3048 dxj=dc_norm(1,nres+j)
3049 dyj=dc_norm(2,nres+j)
3050 dzj=dc_norm(3,nres+j)
3051 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3056 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3057 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3058 om12=dxi*dxj+dyi*dyj+dzi*dzj
3060 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3061 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3067 deltat12=om2-om1+2.0d0
3069 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3070 & +akct*deltad*deltat12
3071 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3072 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3073 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3074 c & " deltat12",deltat12," eij",eij
3075 ed=2*akcm*deltad+akct*deltat12
3077 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3078 eom1=-2*akth*deltat1-pom1-om2*pom2
3079 eom2= 2*akth*deltat2+pom1-om1*pom2
3082 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3085 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3086 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3087 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3088 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3091 C Calculate the components of the gradient in DC and X
3095 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3100 C--------------------------------------------------------------------------
3101 subroutine ebond(estr)
3103 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3105 implicit real*8 (a-h,o-z)
3106 include 'DIMENSIONS'
3107 include 'DIMENSIONS.ZSCOPT'
3108 include 'COMMON.LOCAL'
3109 include 'COMMON.GEO'
3110 include 'COMMON.INTERACT'
3111 include 'COMMON.DERIV'
3112 include 'COMMON.VAR'
3113 include 'COMMON.CHAIN'
3114 include 'COMMON.IOUNITS'
3115 include 'COMMON.NAMES'
3116 include 'COMMON.FFIELD'
3117 include 'COMMON.CONTROL'
3118 logical energy_dec /.false./
3119 double precision u(3),ud(3)
3122 c write (iout,*) "distchainmax",distchainmax
3124 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3125 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3127 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3128 & *dc(j,i-1)/vbld(i)
3130 if (energy_dec) write(iout,*)
3131 & "estr1",i,vbld(i),distchainmax,
3132 & gnmr1(vbld(i),-1.0d0,distchainmax)
3134 diff = vbld(i)-vbldp0
3135 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3138 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3143 estr=0.5d0*AKP*estr+estr1
3145 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3149 if (iti.ne.10 .and. iti.ne.ntyp1) then
3152 diff=vbld(i+nres)-vbldsc0(1,iti)
3153 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3154 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3155 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3157 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3161 diff=vbld(i+nres)-vbldsc0(j,iti)
3162 ud(j)=aksc(j,iti)*diff
3163 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3177 uprod2=uprod2*u(k)*u(k)
3181 usumsqder=usumsqder+ud(j)*uprod2
3183 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3184 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3185 estr=estr+uprod/usum
3187 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3195 C--------------------------------------------------------------------------
3196 subroutine ebend(etheta)
3198 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3199 C angles gamma and its derivatives in consecutive thetas and gammas.
3201 implicit real*8 (a-h,o-z)
3202 include 'DIMENSIONS'
3203 include 'DIMENSIONS.ZSCOPT'
3204 include 'COMMON.LOCAL'
3205 include 'COMMON.GEO'
3206 include 'COMMON.INTERACT'
3207 include 'COMMON.DERIV'
3208 include 'COMMON.VAR'
3209 include 'COMMON.CHAIN'
3210 include 'COMMON.IOUNITS'
3211 include 'COMMON.NAMES'
3212 include 'COMMON.FFIELD'
3213 common /calcthet/ term1,term2,termm,diffak,ratak,
3214 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3215 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3216 double precision y(2),z(2)
3218 c time11=dexp(-2*time)
3221 c write (iout,*) "nres",nres
3222 c write (*,'(a,i2)') 'EBEND ICG=',icg
3223 c write (iout,*) ithet_start,ithet_end
3224 do i=ithet_start,ithet_end
3225 if (itype(i-1).eq.ntyp1) cycle
3226 C Zero the energy function and its derivative at 0 or pi.
3227 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3229 ichir1=isign(1,itype(i-2))
3230 ichir2=isign(1,itype(i))
3231 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3232 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3233 if (itype(i-1).eq.10) then
3234 itype1=isign(10,itype(i-2))
3235 ichir11=isign(1,itype(i-2))
3236 ichir12=isign(1,itype(i-2))
3237 itype2=isign(10,itype(i))
3238 ichir21=isign(1,itype(i))
3239 ichir22=isign(1,itype(i))
3242 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3246 c call proc_proc(phii,icrc)
3247 if (icrc.eq.1) phii=150.0
3257 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3261 c call proc_proc(phii1,icrc)
3262 if (icrc.eq.1) phii1=150.0
3274 C Calculate the "mean" value of theta from the part of the distribution
3275 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3276 C In following comments this theta will be referred to as t_c.
3277 thet_pred_mean=0.0d0
3279 athetk=athet(k,it,ichir1,ichir2)
3280 bthetk=bthet(k,it,ichir1,ichir2)
3282 athetk=athet(k,itype1,ichir11,ichir12)
3283 bthetk=bthet(k,itype2,ichir21,ichir22)
3285 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3287 c write (iout,*) "thet_pred_mean",thet_pred_mean
3288 dthett=thet_pred_mean*ssd
3289 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3290 c write (iout,*) "thet_pred_mean",thet_pred_mean
3291 C Derivatives of the "mean" values in gamma1 and gamma2.
3292 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3293 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3294 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3295 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3297 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3298 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3299 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3300 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3302 if (theta(i).gt.pi-delta) then
3303 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3305 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3306 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3307 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3309 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3311 else if (theta(i).lt.delta) then
3312 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3313 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3314 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3316 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3317 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3320 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3323 etheta=etheta+ethetai
3324 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3325 c & rad2deg*phii,rad2deg*phii1,ethetai
3326 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3327 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3328 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3331 C Ufff.... We've done all this!!!
3334 C---------------------------------------------------------------------------
3335 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3337 implicit real*8 (a-h,o-z)
3338 include 'DIMENSIONS'
3339 include 'COMMON.LOCAL'
3340 include 'COMMON.IOUNITS'
3341 common /calcthet/ term1,term2,termm,diffak,ratak,
3342 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3343 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3344 C Calculate the contributions to both Gaussian lobes.
3345 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3346 C The "polynomial part" of the "standard deviation" of this part of
3350 sig=sig*thet_pred_mean+polthet(j,it)
3352 C Derivative of the "interior part" of the "standard deviation of the"
3353 C gamma-dependent Gaussian lobe in t_c.
3354 sigtc=3*polthet(3,it)
3356 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3359 C Set the parameters of both Gaussian lobes of the distribution.
3360 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3361 fac=sig*sig+sigc0(it)
3364 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3365 sigsqtc=-4.0D0*sigcsq*sigtc
3366 c print *,i,sig,sigtc,sigsqtc
3367 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3368 sigtc=-sigtc/(fac*fac)
3369 C Following variable is sigma(t_c)**(-2)
3370 sigcsq=sigcsq*sigcsq
3372 sig0inv=1.0D0/sig0i**2
3373 delthec=thetai-thet_pred_mean
3374 delthe0=thetai-theta0i
3375 term1=-0.5D0*sigcsq*delthec*delthec
3376 term2=-0.5D0*sig0inv*delthe0*delthe0
3377 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3378 C NaNs in taking the logarithm. We extract the largest exponent which is added
3379 C to the energy (this being the log of the distribution) at the end of energy
3380 C term evaluation for this virtual-bond angle.
3381 if (term1.gt.term2) then
3383 term2=dexp(term2-termm)
3387 term1=dexp(term1-termm)
3390 C The ratio between the gamma-independent and gamma-dependent lobes of
3391 C the distribution is a Gaussian function of thet_pred_mean too.
3392 diffak=gthet(2,it)-thet_pred_mean
3393 ratak=diffak/gthet(3,it)**2
3394 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3395 C Let's differentiate it in thet_pred_mean NOW.
3397 C Now put together the distribution terms to make complete distribution.
3398 termexp=term1+ak*term2
3399 termpre=sigc+ak*sig0i
3400 C Contribution of the bending energy from this theta is just the -log of
3401 C the sum of the contributions from the two lobes and the pre-exponential
3402 C factor. Simple enough, isn't it?
3403 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3404 C NOW the derivatives!!!
3405 C 6/6/97 Take into account the deformation.
3406 E_theta=(delthec*sigcsq*term1
3407 & +ak*delthe0*sig0inv*term2)/termexp
3408 E_tc=((sigtc+aktc*sig0i)/termpre
3409 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3410 & aktc*term2)/termexp)
3413 c-----------------------------------------------------------------------------
3414 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3415 implicit real*8 (a-h,o-z)
3416 include 'DIMENSIONS'
3417 include 'COMMON.LOCAL'
3418 include 'COMMON.IOUNITS'
3419 common /calcthet/ term1,term2,termm,diffak,ratak,
3420 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3421 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3422 delthec=thetai-thet_pred_mean
3423 delthe0=thetai-theta0i
3424 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3425 t3 = thetai-thet_pred_mean
3429 t14 = t12+t6*sigsqtc
3431 t21 = thetai-theta0i
3437 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3438 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3439 & *(-t12*t9-ak*sig0inv*t27)
3443 C--------------------------------------------------------------------------
3444 subroutine ebend(etheta)
3446 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3447 C angles gamma and its derivatives in consecutive thetas and gammas.
3448 C ab initio-derived potentials from
3449 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3451 implicit real*8 (a-h,o-z)
3452 include 'DIMENSIONS'
3453 include 'DIMENSIONS.ZSCOPT'
3454 include 'COMMON.LOCAL'
3455 include 'COMMON.GEO'
3456 include 'COMMON.INTERACT'
3457 include 'COMMON.DERIV'
3458 include 'COMMON.VAR'
3459 include 'COMMON.CHAIN'
3460 include 'COMMON.IOUNITS'
3461 include 'COMMON.NAMES'
3462 include 'COMMON.FFIELD'
3463 include 'COMMON.CONTROL'
3464 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3465 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3466 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3467 & sinph1ph2(maxdouble,maxdouble)
3468 logical lprn /.false./, lprn1 /.false./
3470 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3471 do i=ithet_start,ithet_end
3472 c if (itype(i-1).eq.ntyp1) cycle
3473 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3474 &(itype(i).eq.ntyp1)) cycle
3475 if (iabs(itype(i+1)).eq.20) iblock=2
3476 if (iabs(itype(i+1)).ne.20) iblock=1
3480 theti2=0.5d0*theta(i)
3481 ityp2=ithetyp((itype(i-1)))
3483 coskt(k)=dcos(k*theti2)
3484 sinkt(k)=dsin(k*theti2)
3486 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3489 if (phii.ne.phii) phii=150.0
3493 ityp1=ithetyp((itype(i-2)))
3495 cosph1(k)=dcos(k*phii)
3496 sinph1(k)=dsin(k*phii)
3502 ityp1=ithetyp((itype(i-2)))
3507 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3510 if (phii1.ne.phii1) phii1=150.0
3515 ityp3=ithetyp((itype(i)))
3517 cosph2(k)=dcos(k*phii1)
3518 sinph2(k)=dsin(k*phii1)
3523 ityp3=ithetyp((itype(i)))
3529 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3530 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3532 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3535 ccl=cosph1(l)*cosph2(k-l)
3536 ssl=sinph1(l)*sinph2(k-l)
3537 scl=sinph1(l)*cosph2(k-l)
3538 csl=cosph1(l)*sinph2(k-l)
3539 cosph1ph2(l,k)=ccl-ssl
3540 cosph1ph2(k,l)=ccl+ssl
3541 sinph1ph2(l,k)=scl+csl
3542 sinph1ph2(k,l)=scl-csl
3546 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3547 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3548 write (iout,*) "coskt and sinkt"
3550 write (iout,*) k,coskt(k),sinkt(k)
3554 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3555 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3558 & write (iout,*) "k",k,"
3559 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3560 & " ethetai",ethetai
3563 write (iout,*) "cosph and sinph"
3565 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3567 write (iout,*) "cosph1ph2 and sinph2ph2"
3570 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3571 & sinph1ph2(l,k),sinph1ph2(k,l)
3574 write(iout,*) "ethetai",ethetai
3578 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3579 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3580 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3581 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3582 ethetai=ethetai+sinkt(m)*aux
3583 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3584 dephii=dephii+k*sinkt(m)*(
3585 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3586 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3587 dephii1=dephii1+k*sinkt(m)*(
3588 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3589 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3591 & write (iout,*) "m",m," k",k," bbthet",
3592 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3593 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3594 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3595 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3599 & write(iout,*) "ethetai",ethetai
3603 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3604 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3605 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3606 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3607 ethetai=ethetai+sinkt(m)*aux
3608 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3609 dephii=dephii+l*sinkt(m)*(
3610 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3611 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3612 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3613 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3614 dephii1=dephii1+(k-l)*sinkt(m)*(
3615 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3616 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3617 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3618 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3620 write (iout,*) "m",m," k",k," l",l," ffthet",
3621 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3622 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3623 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3624 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3625 & " ethetai",ethetai
3626 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3627 & cosph1ph2(k,l)*sinkt(m),
3628 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3634 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3635 & i,theta(i)*rad2deg,phii*rad2deg,
3636 & phii1*rad2deg,ethetai
3637 etheta=etheta+ethetai
3638 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3639 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3640 c gloc(nphi+i-2,icg)=wang*dethetai
3641 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3647 c-----------------------------------------------------------------------------
3648 subroutine esc(escloc)
3649 C Calculate the local energy of a side chain and its derivatives in the
3650 C corresponding virtual-bond valence angles THETA and the spherical angles
3652 implicit real*8 (a-h,o-z)
3653 include 'DIMENSIONS'
3654 include 'DIMENSIONS.ZSCOPT'
3655 include 'COMMON.GEO'
3656 include 'COMMON.LOCAL'
3657 include 'COMMON.VAR'
3658 include 'COMMON.INTERACT'
3659 include 'COMMON.DERIV'
3660 include 'COMMON.CHAIN'
3661 include 'COMMON.IOUNITS'
3662 include 'COMMON.NAMES'
3663 include 'COMMON.FFIELD'
3664 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3665 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3666 common /sccalc/ time11,time12,time112,theti,it,nlobit
3669 c write (iout,'(a)') 'ESC'
3670 do i=loc_start,loc_end
3672 if (it.eq.ntyp1) cycle
3673 if (it.eq.10) goto 1
3674 nlobit=nlob(iabs(it))
3675 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3676 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3677 theti=theta(i+1)-pipol
3681 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3683 if (x(2).gt.pi-delta) then
3687 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3689 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3690 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3692 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3693 & ddersc0(1),dersc(1))
3694 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3695 & ddersc0(3),dersc(3))
3697 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3699 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3700 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3701 & dersc0(2),esclocbi,dersc02)
3702 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3704 call splinthet(x(2),0.5d0*delta,ss,ssd)
3709 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3711 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3712 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3714 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3716 c write (iout,*) escloci
3717 else if (x(2).lt.delta) then
3721 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3723 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3724 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3726 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3727 & ddersc0(1),dersc(1))
3728 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3729 & ddersc0(3),dersc(3))
3731 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3733 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3734 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3735 & dersc0(2),esclocbi,dersc02)
3736 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3741 call splinthet(x(2),0.5d0*delta,ss,ssd)
3743 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3745 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3746 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3748 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3749 c write (iout,*) escloci
3751 call enesc(x,escloci,dersc,ddummy,.false.)
3754 escloc=escloc+escloci
3755 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3757 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3759 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3760 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3765 C---------------------------------------------------------------------------
3766 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3767 implicit real*8 (a-h,o-z)
3768 include 'DIMENSIONS'
3769 include 'COMMON.GEO'
3770 include 'COMMON.LOCAL'
3771 include 'COMMON.IOUNITS'
3772 common /sccalc/ time11,time12,time112,theti,it,nlobit
3773 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3774 double precision contr(maxlob,-1:1)
3776 c write (iout,*) 'it=',it,' nlobit=',nlobit
3780 if (mixed) ddersc(j)=0.0d0
3784 C Because of periodicity of the dependence of the SC energy in omega we have
3785 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3786 C To avoid underflows, first compute & store the exponents.
3794 z(k)=x(k)-censc(k,j,it)
3799 Axk=Axk+gaussc(l,k,j,it)*z(l)
3805 expfac=expfac+Ax(k,j,iii)*z(k)
3813 C As in the case of ebend, we want to avoid underflows in exponentiation and
3814 C subsequent NaNs and INFs in energy calculation.
3815 C Find the largest exponent
3819 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3823 cd print *,'it=',it,' emin=',emin
3825 C Compute the contribution to SC energy and derivatives
3829 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3830 cd print *,'j=',j,' expfac=',expfac
3831 escloc_i=escloc_i+expfac
3833 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3837 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3838 & +gaussc(k,2,j,it))*expfac
3845 dersc(1)=dersc(1)/cos(theti)**2
3846 ddersc(1)=ddersc(1)/cos(theti)**2
3849 escloci=-(dlog(escloc_i)-emin)
3851 dersc(j)=dersc(j)/escloc_i
3855 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3860 C------------------------------------------------------------------------------
3861 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3862 implicit real*8 (a-h,o-z)
3863 include 'DIMENSIONS'
3864 include 'COMMON.GEO'
3865 include 'COMMON.LOCAL'
3866 include 'COMMON.IOUNITS'
3867 common /sccalc/ time11,time12,time112,theti,it,nlobit
3868 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3869 double precision contr(maxlob)
3880 z(k)=x(k)-censc(k,j,it)
3886 Axk=Axk+gaussc(l,k,j,it)*z(l)
3892 expfac=expfac+Ax(k,j)*z(k)
3897 C As in the case of ebend, we want to avoid underflows in exponentiation and
3898 C subsequent NaNs and INFs in energy calculation.
3899 C Find the largest exponent
3902 if (emin.gt.contr(j)) emin=contr(j)
3906 C Compute the contribution to SC energy and derivatives
3910 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3911 escloc_i=escloc_i+expfac
3913 dersc(k)=dersc(k)+Ax(k,j)*expfac
3915 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3916 & +gaussc(1,2,j,it))*expfac
3920 dersc(1)=dersc(1)/cos(theti)**2
3921 dersc12=dersc12/cos(theti)**2
3922 escloci=-(dlog(escloc_i)-emin)
3924 dersc(j)=dersc(j)/escloc_i
3926 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3930 c----------------------------------------------------------------------------------
3931 subroutine esc(escloc)
3932 C Calculate the local energy of a side chain and its derivatives in the
3933 C corresponding virtual-bond valence angles THETA and the spherical angles
3934 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3935 C added by Urszula Kozlowska. 07/11/2007
3937 implicit real*8 (a-h,o-z)
3938 include 'DIMENSIONS'
3939 include 'DIMENSIONS.ZSCOPT'
3940 include 'COMMON.GEO'
3941 include 'COMMON.LOCAL'
3942 include 'COMMON.VAR'
3943 include 'COMMON.SCROT'
3944 include 'COMMON.INTERACT'
3945 include 'COMMON.DERIV'
3946 include 'COMMON.CHAIN'
3947 include 'COMMON.IOUNITS'
3948 include 'COMMON.NAMES'
3949 include 'COMMON.FFIELD'
3950 include 'COMMON.CONTROL'
3951 include 'COMMON.VECTORS'
3952 double precision x_prime(3),y_prime(3),z_prime(3)
3953 & , sumene,dsc_i,dp2_i,x(65),
3954 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3955 & de_dxx,de_dyy,de_dzz,de_dt
3956 double precision s1_t,s1_6_t,s2_t,s2_6_t
3958 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3959 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3960 & dt_dCi(3),dt_dCi1(3)
3961 common /sccalc/ time11,time12,time112,theti,it,nlobit
3964 do i=loc_start,loc_end
3965 if (itype(i).eq.ntyp1) cycle
3966 costtab(i+1) =dcos(theta(i+1))
3967 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3968 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3969 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3970 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3971 cosfac=dsqrt(cosfac2)
3972 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3973 sinfac=dsqrt(sinfac2)
3975 if (it.eq.10) goto 1
3977 C Compute the axes of tghe local cartesian coordinates system; store in
3978 c x_prime, y_prime and z_prime
3985 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3986 C & dc_norm(3,i+nres)
3988 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3989 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3992 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
3995 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3996 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3997 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3998 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3999 c & " xy",scalar(x_prime(1),y_prime(1)),
4000 c & " xz",scalar(x_prime(1),z_prime(1)),
4001 c & " yy",scalar(y_prime(1),y_prime(1)),
4002 c & " yz",scalar(y_prime(1),z_prime(1)),
4003 c & " zz",scalar(z_prime(1),z_prime(1))
4005 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4006 C to local coordinate system. Store in xx, yy, zz.
4012 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4013 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4014 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4021 C Compute the energy of the ith side cbain
4023 c write (2,*) "xx",xx," yy",yy," zz",zz
4026 x(j) = sc_parmin(j,it)
4029 Cc diagnostics - remove later
4031 yy1 = dsin(alph(2))*dcos(omeg(2))
4032 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4033 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4034 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4036 C," --- ", xx_w,yy_w,zz_w
4039 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4040 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4042 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4043 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4045 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4046 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4047 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4048 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4049 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4051 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4052 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4053 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4054 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4055 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4057 dsc_i = 0.743d0+x(61)
4059 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4060 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4061 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4062 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4063 s1=(1+x(63))/(0.1d0 + dscp1)
4064 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4065 s2=(1+x(65))/(0.1d0 + dscp2)
4066 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4067 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4068 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4069 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4071 c & dscp1,dscp2,sumene
4072 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4073 escloc = escloc + sumene
4074 c write (2,*) "escloc",escloc
4075 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4077 if (.not. calc_grad) goto 1
4080 C This section to check the numerical derivatives of the energy of ith side
4081 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4082 C #define DEBUG in the code to turn it on.
4084 write (2,*) "sumene =",sumene
4088 write (2,*) xx,yy,zz
4089 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4090 de_dxx_num=(sumenep-sumene)/aincr
4092 write (2,*) "xx+ sumene from enesc=",sumenep
4095 write (2,*) xx,yy,zz
4096 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4097 de_dyy_num=(sumenep-sumene)/aincr
4099 write (2,*) "yy+ sumene from enesc=",sumenep
4102 write (2,*) xx,yy,zz
4103 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4104 de_dzz_num=(sumenep-sumene)/aincr
4106 write (2,*) "zz+ sumene from enesc=",sumenep
4107 costsave=cost2tab(i+1)
4108 sintsave=sint2tab(i+1)
4109 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4110 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4111 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4112 de_dt_num=(sumenep-sumene)/aincr
4113 write (2,*) " t+ sumene from enesc=",sumenep
4114 cost2tab(i+1)=costsave
4115 sint2tab(i+1)=sintsave
4116 C End of diagnostics section.
4119 C Compute the gradient of esc
4121 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4122 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4123 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4124 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4125 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4126 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4127 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4128 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4129 pom1=(sumene3*sint2tab(i+1)+sumene1)
4130 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4131 pom2=(sumene4*cost2tab(i+1)+sumene2)
4132 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4133 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4134 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4135 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4137 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4138 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4139 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4141 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4142 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4143 & +(pom1+pom2)*pom_dx
4145 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4148 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4149 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4150 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4152 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4153 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4154 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4155 & +x(59)*zz**2 +x(60)*xx*zz
4156 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4157 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4158 & +(pom1-pom2)*pom_dy
4160 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4163 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4164 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4165 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4166 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4167 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4168 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4169 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4170 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4172 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4175 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4176 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4177 & +pom1*pom_dt1+pom2*pom_dt2
4179 write(2,*), "de_dt = ", de_dt,de_dt_num
4183 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4184 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4185 cosfac2xx=cosfac2*xx
4186 sinfac2yy=sinfac2*yy
4188 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4190 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4192 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4193 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4194 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4195 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4196 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4197 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4198 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4199 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4200 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4201 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4205 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4206 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4207 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4208 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4211 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4212 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4213 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4215 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4216 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4220 dXX_Ctab(k,i)=dXX_Ci(k)
4221 dXX_C1tab(k,i)=dXX_Ci1(k)
4222 dYY_Ctab(k,i)=dYY_Ci(k)
4223 dYY_C1tab(k,i)=dYY_Ci1(k)
4224 dZZ_Ctab(k,i)=dZZ_Ci(k)
4225 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4226 dXX_XYZtab(k,i)=dXX_XYZ(k)
4227 dYY_XYZtab(k,i)=dYY_XYZ(k)
4228 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4232 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4233 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4234 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4235 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4236 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4238 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4239 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4240 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4241 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4242 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4243 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4244 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4245 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4247 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4248 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4250 C to check gradient call subroutine check_grad
4257 c------------------------------------------------------------------------------
4258 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4260 C This procedure calculates two-body contact function g(rij) and its derivative:
4263 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4266 C where x=(rij-r0ij)/delta
4268 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4271 double precision rij,r0ij,eps0ij,fcont,fprimcont
4272 double precision x,x2,x4,delta
4276 if (x.lt.-1.0D0) then
4279 else if (x.le.1.0D0) then
4282 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4283 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4290 c------------------------------------------------------------------------------
4291 subroutine splinthet(theti,delta,ss,ssder)
4292 implicit real*8 (a-h,o-z)
4293 include 'DIMENSIONS'
4294 include 'DIMENSIONS.ZSCOPT'
4295 include 'COMMON.VAR'
4296 include 'COMMON.GEO'
4299 if (theti.gt.pipol) then
4300 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4302 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4307 c------------------------------------------------------------------------------
4308 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4310 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4311 double precision ksi,ksi2,ksi3,a1,a2,a3
4312 a1=fprim0*delta/(f1-f0)
4318 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4319 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4322 c------------------------------------------------------------------------------
4323 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4325 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4326 double precision ksi,ksi2,ksi3,a1,a2,a3
4331 a2=3*(f1x-f0x)-2*fprim0x*delta
4332 a3=fprim0x*delta-2*(f1x-f0x)
4333 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4336 C-----------------------------------------------------------------------------
4338 C-----------------------------------------------------------------------------
4339 subroutine etor(etors,edihcnstr,fact)
4340 implicit real*8 (a-h,o-z)
4341 include 'DIMENSIONS'
4342 include 'DIMENSIONS.ZSCOPT'
4343 include 'COMMON.VAR'
4344 include 'COMMON.GEO'
4345 include 'COMMON.LOCAL'
4346 include 'COMMON.TORSION'
4347 include 'COMMON.INTERACT'
4348 include 'COMMON.DERIV'
4349 include 'COMMON.CHAIN'
4350 include 'COMMON.NAMES'
4351 include 'COMMON.IOUNITS'
4352 include 'COMMON.FFIELD'
4353 include 'COMMON.TORCNSTR'
4355 C Set lprn=.true. for debugging
4359 do i=iphi_start,iphi_end
4360 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4361 & .or. itype(i).eq.ntyp1) cycle
4362 itori=itortyp(itype(i-2))
4363 itori1=itortyp(itype(i-1))
4366 C Proline-Proline pair is a special case...
4367 if (itori.eq.3 .and. itori1.eq.3) then
4368 if (phii.gt.-dwapi3) then
4370 fac=1.0D0/(1.0D0-cosphi)
4371 etorsi=v1(1,3,3)*fac
4372 etorsi=etorsi+etorsi
4373 etors=etors+etorsi-v1(1,3,3)
4374 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4377 v1ij=v1(j+1,itori,itori1)
4378 v2ij=v2(j+1,itori,itori1)
4381 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4382 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4386 v1ij=v1(j,itori,itori1)
4387 v2ij=v2(j,itori,itori1)
4390 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4391 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4395 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4396 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4397 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4398 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4399 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4401 ! 6/20/98 - dihedral angle constraints
4404 itori=idih_constr(i)
4407 if (difi.gt.drange(i)) then
4409 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4410 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4411 else if (difi.lt.-drange(i)) then
4413 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4414 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4416 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4417 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4419 ! write (iout,*) 'edihcnstr',edihcnstr
4422 c------------------------------------------------------------------------------
4424 subroutine etor(etors,edihcnstr,fact)
4425 implicit real*8 (a-h,o-z)
4426 include 'DIMENSIONS'
4427 include 'DIMENSIONS.ZSCOPT'
4428 include 'COMMON.VAR'
4429 include 'COMMON.GEO'
4430 include 'COMMON.LOCAL'
4431 include 'COMMON.TORSION'
4432 include 'COMMON.INTERACT'
4433 include 'COMMON.DERIV'
4434 include 'COMMON.CHAIN'
4435 include 'COMMON.NAMES'
4436 include 'COMMON.IOUNITS'
4437 include 'COMMON.FFIELD'
4438 include 'COMMON.TORCNSTR'
4440 C Set lprn=.true. for debugging
4444 do i=iphi_start,iphi_end
4445 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4446 & .or. itype(i).eq.ntyp1) cycle
4447 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4448 if (iabs(itype(i)).eq.20) then
4453 itori=itortyp(itype(i-2))
4454 itori1=itortyp(itype(i-1))
4457 C Regular cosine and sine terms
4458 do j=1,nterm(itori,itori1,iblock)
4459 v1ij=v1(j,itori,itori1,iblock)
4460 v2ij=v2(j,itori,itori1,iblock)
4463 etors=etors+v1ij*cosphi+v2ij*sinphi
4464 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4468 C E = SUM ----------------------------------- - v1
4469 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4471 cosphi=dcos(0.5d0*phii)
4472 sinphi=dsin(0.5d0*phii)
4473 do j=1,nlor(itori,itori1,iblock)
4474 vl1ij=vlor1(j,itori,itori1)
4475 vl2ij=vlor2(j,itori,itori1)
4476 vl3ij=vlor3(j,itori,itori1)
4477 pom=vl2ij*cosphi+vl3ij*sinphi
4478 pom1=1.0d0/(pom*pom+1.0d0)
4479 etors=etors+vl1ij*pom1
4480 c if (energy_dec) etors_ii=etors_ii+
4483 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4485 C Subtract the constant term
4486 etors=etors-v0(itori,itori1,iblock)
4488 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4489 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4490 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4491 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4492 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4495 ! 6/20/98 - dihedral angle constraints
4498 itori=idih_constr(i)
4500 difi=pinorm(phii-phi0(i))
4502 if (difi.gt.drange(i)) then
4504 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4505 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4506 edihi=0.25d0*ftors*difi**4
4507 else if (difi.lt.-drange(i)) then
4509 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4510 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4511 edihi=0.25d0*ftors*difi**4
4515 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4517 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4518 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4520 ! write (iout,*) 'edihcnstr',edihcnstr
4523 c----------------------------------------------------------------------------
4524 subroutine etor_d(etors_d,fact2)
4525 C 6/23/01 Compute double torsional energy
4526 implicit real*8 (a-h,o-z)
4527 include 'DIMENSIONS'
4528 include 'DIMENSIONS.ZSCOPT'
4529 include 'COMMON.VAR'
4530 include 'COMMON.GEO'
4531 include 'COMMON.LOCAL'
4532 include 'COMMON.TORSION'
4533 include 'COMMON.INTERACT'
4534 include 'COMMON.DERIV'
4535 include 'COMMON.CHAIN'
4536 include 'COMMON.NAMES'
4537 include 'COMMON.IOUNITS'
4538 include 'COMMON.FFIELD'
4539 include 'COMMON.TORCNSTR'
4541 C Set lprn=.true. for debugging
4545 do i=iphi_start,iphi_end-1
4546 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4547 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4548 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4550 itori=itortyp(itype(i-2))
4551 itori1=itortyp(itype(i-1))
4552 itori2=itortyp(itype(i))
4558 if (iabs(itype(i+1)).eq.20) iblock=2
4559 C Regular cosine and sine terms
4560 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4561 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4562 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4563 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4564 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4565 cosphi1=dcos(j*phii)
4566 sinphi1=dsin(j*phii)
4567 cosphi2=dcos(j*phii1)
4568 sinphi2=dsin(j*phii1)
4569 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4570 & v2cij*cosphi2+v2sij*sinphi2
4571 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4572 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4574 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4576 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4577 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4578 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4579 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4580 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4581 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4582 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4583 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4584 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4585 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4586 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4587 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4588 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4589 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4592 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4593 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4599 c------------------------------------------------------------------------------
4600 subroutine eback_sc_corr(esccor)
4601 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4602 c conformational states; temporarily implemented as differences
4603 c between UNRES torsional potentials (dependent on three types of
4604 c residues) and the torsional potentials dependent on all 20 types
4605 c of residues computed from AM1 energy surfaces of terminally-blocked
4606 c amino-acid residues.
4607 implicit real*8 (a-h,o-z)
4608 include 'DIMENSIONS'
4609 include 'DIMENSIONS.ZSCOPT'
4610 include 'COMMON.VAR'
4611 include 'COMMON.GEO'
4612 include 'COMMON.LOCAL'
4613 include 'COMMON.TORSION'
4614 include 'COMMON.SCCOR'
4615 include 'COMMON.INTERACT'
4616 include 'COMMON.DERIV'
4617 include 'COMMON.CHAIN'
4618 include 'COMMON.NAMES'
4619 include 'COMMON.IOUNITS'
4620 include 'COMMON.FFIELD'
4621 include 'COMMON.CONTROL'
4623 C Set lprn=.true. for debugging
4626 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4628 do i=itau_start,itau_end
4629 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4631 isccori=isccortyp(itype(i-2))
4632 isccori1=isccortyp(itype(i-1))
4634 do intertyp=1,3 !intertyp
4635 cc Added 09 May 2012 (Adasko)
4636 cc Intertyp means interaction type of backbone mainchain correlation:
4637 c 1 = SC...Ca...Ca...Ca
4638 c 2 = Ca...Ca...Ca...SC
4639 c 3 = SC...Ca...Ca...SCi
4641 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4642 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4643 & (itype(i-1).eq.ntyp1)))
4644 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4645 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4646 & .or.(itype(i).eq.ntyp1)))
4647 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4648 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4649 & (itype(i-3).eq.ntyp1)))) cycle
4650 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4651 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4653 do j=1,nterm_sccor(isccori,isccori1)
4654 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4655 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4656 cosphi=dcos(j*tauangle(intertyp,i))
4657 sinphi=dsin(j*tauangle(intertyp,i))
4658 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4659 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4661 write (iout,*)"EBACK_SC_COR",esccor,i
4662 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4663 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4664 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4666 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4667 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4668 & (v1sccor(j,1,itori,itori1),j=1,6)
4669 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4670 c gsccor_loc(i-3)=gloci
4675 c------------------------------------------------------------------------------
4676 subroutine multibody(ecorr)
4677 C This subroutine calculates multi-body contributions to energy following
4678 C the idea of Skolnick et al. If side chains I and J make a contact and
4679 C at the same time side chains I+1 and J+1 make a contact, an extra
4680 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4681 implicit real*8 (a-h,o-z)
4682 include 'DIMENSIONS'
4683 include 'COMMON.IOUNITS'
4684 include 'COMMON.DERIV'
4685 include 'COMMON.INTERACT'
4686 include 'COMMON.CONTACTS'
4687 double precision gx(3),gx1(3)
4690 C Set lprn=.true. for debugging
4694 write (iout,'(a)') 'Contact function values:'
4696 write (iout,'(i2,20(1x,i2,f10.5))')
4697 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4712 num_conti=num_cont(i)
4713 num_conti1=num_cont(i1)
4718 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4719 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4720 cd & ' ishift=',ishift
4721 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4722 C The system gains extra energy.
4723 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4724 endif ! j1==j+-ishift
4733 c------------------------------------------------------------------------------
4734 double precision function esccorr(i,j,k,l,jj,kk)
4735 implicit real*8 (a-h,o-z)
4736 include 'DIMENSIONS'
4737 include 'COMMON.IOUNITS'
4738 include 'COMMON.DERIV'
4739 include 'COMMON.INTERACT'
4740 include 'COMMON.CONTACTS'
4741 double precision gx(3),gx1(3)
4746 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4747 C Calculate the multi-body contribution to energy.
4748 C Calculate multi-body contributions to the gradient.
4749 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4750 cd & k,l,(gacont(m,kk,k),m=1,3)
4752 gx(m) =ekl*gacont(m,jj,i)
4753 gx1(m)=eij*gacont(m,kk,k)
4754 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4755 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4756 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4757 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4761 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4766 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4772 c------------------------------------------------------------------------------
4774 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4775 implicit real*8 (a-h,o-z)
4776 include 'DIMENSIONS'
4777 integer dimen1,dimen2,atom,indx
4778 double precision buffer(dimen1,dimen2)
4779 double precision zapas
4780 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4781 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
4782 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4783 num_kont=num_cont_hb(atom)
4787 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4790 buffer(i,indx+22)=facont_hb(i,atom)
4791 buffer(i,indx+23)=ees0p(i,atom)
4792 buffer(i,indx+24)=ees0m(i,atom)
4793 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4795 buffer(1,indx+26)=dfloat(num_kont)
4798 c------------------------------------------------------------------------------
4799 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4800 implicit real*8 (a-h,o-z)
4801 include 'DIMENSIONS'
4802 integer dimen1,dimen2,atom,indx
4803 double precision buffer(dimen1,dimen2)
4804 double precision zapas
4805 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4806 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
4807 & ees0m(ntyp,maxres),
4808 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4809 num_kont=buffer(1,indx+26)
4810 num_kont_old=num_cont_hb(atom)
4811 num_cont_hb(atom)=num_kont+num_kont_old
4816 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4819 facont_hb(ii,atom)=buffer(i,indx+22)
4820 ees0p(ii,atom)=buffer(i,indx+23)
4821 ees0m(ii,atom)=buffer(i,indx+24)
4822 jcont_hb(ii,atom)=buffer(i,indx+25)
4826 c------------------------------------------------------------------------------
4828 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4829 C This subroutine calculates multi-body contributions to hydrogen-bonding
4830 implicit real*8 (a-h,o-z)
4831 include 'DIMENSIONS'
4832 include 'DIMENSIONS.ZSCOPT'
4833 include 'COMMON.IOUNITS'
4835 include 'COMMON.INFO'
4837 include 'COMMON.FFIELD'
4838 include 'COMMON.DERIV'
4839 include 'COMMON.INTERACT'
4840 include 'COMMON.CONTACTS'
4842 parameter (max_cont=maxconts)
4843 parameter (max_dim=2*(8*3+2))
4844 parameter (msglen1=max_cont*max_dim*4)
4845 parameter (msglen2=2*msglen1)
4846 integer source,CorrelType,CorrelID,Error
4847 double precision buffer(max_cont,max_dim)
4849 double precision gx(3),gx1(3)
4852 C Set lprn=.true. for debugging
4857 if (fgProcs.le.1) goto 30
4859 write (iout,'(a)') 'Contact function values:'
4861 write (iout,'(2i3,50(1x,i2,f5.2))')
4862 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4863 & j=1,num_cont_hb(i))
4866 C Caution! Following code assumes that electrostatic interactions concerning
4867 C a given atom are split among at most two processors!
4877 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4880 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4881 if (MyRank.gt.0) then
4882 C Send correlation contributions to the preceding processor
4884 nn=num_cont_hb(iatel_s)
4885 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4886 cd write (iout,*) 'The BUFFER array:'
4888 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4890 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4892 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4893 C Clear the contacts of the atom passed to the neighboring processor
4894 nn=num_cont_hb(iatel_s+1)
4896 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4898 num_cont_hb(iatel_s)=0
4900 cd write (iout,*) 'Processor ',MyID,MyRank,
4901 cd & ' is sending correlation contribution to processor',MyID-1,
4902 cd & ' msglen=',msglen
4903 cd write (*,*) 'Processor ',MyID,MyRank,
4904 cd & ' is sending correlation contribution to processor',MyID-1,
4905 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4906 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4907 cd write (iout,*) 'Processor ',MyID,
4908 cd & ' has sent correlation contribution to processor',MyID-1,
4909 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4910 cd write (*,*) 'Processor ',MyID,
4911 cd & ' has sent correlation contribution to processor',MyID-1,
4912 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4914 endif ! (MyRank.gt.0)
4918 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4919 if (MyRank.lt.fgProcs-1) then
4920 C Receive correlation contributions from the next processor
4922 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4923 cd write (iout,*) 'Processor',MyID,
4924 cd & ' is receiving correlation contribution from processor',MyID+1,
4925 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4926 cd write (*,*) 'Processor',MyID,
4927 cd & ' is receiving correlation contribution from processor',MyID+1,
4928 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4930 do while (nbytes.le.0)
4931 call mp_probe(MyID+1,CorrelType,nbytes)
4933 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4934 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4935 cd write (iout,*) 'Processor',MyID,
4936 cd & ' has received correlation contribution from processor',MyID+1,
4937 cd & ' msglen=',msglen,' nbytes=',nbytes
4938 cd write (iout,*) 'The received BUFFER array:'
4940 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4942 if (msglen.eq.msglen1) then
4943 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4944 else if (msglen.eq.msglen2) then
4945 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4946 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4949 & 'ERROR!!!! message length changed while processing correlations.'
4951 & 'ERROR!!!! message length changed while processing correlations.'
4952 call mp_stopall(Error)
4953 endif ! msglen.eq.msglen1
4954 endif ! MyRank.lt.fgProcs-1
4961 write (iout,'(a)') 'Contact function values:'
4963 write (iout,'(2i3,50(1x,i2,f5.2))')
4964 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4965 & j=1,num_cont_hb(i))
4969 C Remove the loop below after debugging !!!
4976 C Calculate the local-electrostatic correlation terms
4977 do i=iatel_s,iatel_e+1
4979 num_conti=num_cont_hb(i)
4980 num_conti1=num_cont_hb(i+1)
4985 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4986 c & ' jj=',jj,' kk=',kk
4987 if (j1.eq.j+1 .or. j1.eq.j-1) then
4988 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4989 C The system gains extra energy.
4990 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4992 else if (j1.eq.j) then
4993 C Contacts I-J and I-(J+1) occur simultaneously.
4994 C The system loses extra energy.
4995 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5000 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5001 c & ' jj=',jj,' kk=',kk
5003 C Contacts I-J and (I+1)-J occur simultaneously.
5004 C The system loses extra energy.
5005 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5012 c------------------------------------------------------------------------------
5013 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5015 C This subroutine calculates multi-body contributions to hydrogen-bonding
5016 implicit real*8 (a-h,o-z)
5017 include 'DIMENSIONS'
5018 include 'DIMENSIONS.ZSCOPT'
5019 include 'COMMON.IOUNITS'
5021 include 'COMMON.INFO'
5023 include 'COMMON.FFIELD'
5024 include 'COMMON.DERIV'
5025 include 'COMMON.INTERACT'
5026 include 'COMMON.CONTACTS'
5028 parameter (max_cont=maxconts)
5029 parameter (max_dim=2*(8*3+2))
5030 parameter (msglen1=max_cont*max_dim*4)
5031 parameter (msglen2=2*msglen1)
5032 integer source,CorrelType,CorrelID,Error
5033 double precision buffer(max_cont,max_dim)
5035 double precision gx(3),gx1(3)
5038 C Set lprn=.true. for debugging
5044 if (fgProcs.le.1) goto 30
5046 write (iout,'(a)') 'Contact function values:'
5048 write (iout,'(2i3,50(1x,i2,f5.2))')
5049 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5050 & j=1,num_cont_hb(i))
5053 C Caution! Following code assumes that electrostatic interactions concerning
5054 C a given atom are split among at most two processors!
5064 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5067 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5068 if (MyRank.gt.0) then
5069 C Send correlation contributions to the preceding processor
5071 nn=num_cont_hb(iatel_s)
5072 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5073 cd write (iout,*) 'The BUFFER array:'
5075 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5077 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5079 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5080 C Clear the contacts of the atom passed to the neighboring processor
5081 nn=num_cont_hb(iatel_s+1)
5083 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5085 num_cont_hb(iatel_s)=0
5087 cd write (iout,*) 'Processor ',MyID,MyRank,
5088 cd & ' is sending correlation contribution to processor',MyID-1,
5089 cd & ' msglen=',msglen
5090 cd write (*,*) 'Processor ',MyID,MyRank,
5091 cd & ' is sending correlation contribution to processor',MyID-1,
5092 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5093 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5094 cd write (iout,*) 'Processor ',MyID,
5095 cd & ' has sent correlation contribution to processor',MyID-1,
5096 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5097 cd write (*,*) 'Processor ',MyID,
5098 cd & ' has sent correlation contribution to processor',MyID-1,
5099 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5101 endif ! (MyRank.gt.0)
5105 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5106 if (MyRank.lt.fgProcs-1) then
5107 C Receive correlation contributions from the next processor
5109 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5110 cd write (iout,*) 'Processor',MyID,
5111 cd & ' is receiving correlation contribution from processor',MyID+1,
5112 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5113 cd write (*,*) 'Processor',MyID,
5114 cd & ' is receiving correlation contribution from processor',MyID+1,
5115 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5117 do while (nbytes.le.0)
5118 call mp_probe(MyID+1,CorrelType,nbytes)
5120 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5121 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5122 cd write (iout,*) 'Processor',MyID,
5123 cd & ' has received correlation contribution from processor',MyID+1,
5124 cd & ' msglen=',msglen,' nbytes=',nbytes
5125 cd write (iout,*) 'The received BUFFER array:'
5127 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5129 if (msglen.eq.msglen1) then
5130 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5131 else if (msglen.eq.msglen2) then
5132 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5133 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5136 & 'ERROR!!!! message length changed while processing correlations.'
5138 & 'ERROR!!!! message length changed while processing correlations.'
5139 call mp_stopall(Error)
5140 endif ! msglen.eq.msglen1
5141 endif ! MyRank.lt.fgProcs-1
5148 write (iout,'(a)') 'Contact function values:'
5150 write (iout,'(2i3,50(1x,i2,f5.2))')
5151 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5152 & j=1,num_cont_hb(i))
5158 C Remove the loop below after debugging !!!
5165 C Calculate the dipole-dipole interaction energies
5166 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5167 do i=iatel_s,iatel_e+1
5168 num_conti=num_cont_hb(i)
5175 C Calculate the local-electrostatic correlation terms
5176 do i=iatel_s,iatel_e+1
5178 num_conti=num_cont_hb(i)
5179 num_conti1=num_cont_hb(i+1)
5184 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5185 c & ' jj=',jj,' kk=',kk
5186 if (j1.eq.j+1 .or. j1.eq.j-1) then
5187 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5188 C The system gains extra energy.
5190 sqd1=dsqrt(d_cont(jj,i))
5191 sqd2=dsqrt(d_cont(kk,i1))
5192 sred_geom = sqd1*sqd2
5193 IF (sred_geom.lt.cutoff_corr) THEN
5194 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5196 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5197 c & ' jj=',jj,' kk=',kk
5198 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5199 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5201 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5202 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5205 cd write (iout,*) 'sred_geom=',sred_geom,
5206 cd & ' ekont=',ekont,' fprim=',fprimcont
5207 call calc_eello(i,j,i+1,j1,jj,kk)
5208 if (wcorr4.gt.0.0d0)
5209 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5210 if (wcorr5.gt.0.0d0)
5211 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5212 c print *,"wcorr5",ecorr5
5213 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5214 cd write(2,*)'ijkl',i,j,i+1,j1
5215 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5216 & .or. wturn6.eq.0.0d0))then
5217 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5218 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5219 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5220 cd & 'ecorr6=',ecorr6
5221 cd write (iout,'(4e15.5)') sred_geom,
5222 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5223 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5224 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5225 else if (wturn6.gt.0.0d0
5226 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5227 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5228 eturn6=eturn6+eello_turn6(i,jj,kk)
5229 cd write (2,*) 'multibody_eello:eturn6',eturn6
5233 else if (j1.eq.j) then
5234 C Contacts I-J and I-(J+1) occur simultaneously.
5235 C The system loses extra energy.
5236 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5241 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5242 c & ' jj=',jj,' kk=',kk
5244 C Contacts I-J and (I+1)-J occur simultaneously.
5245 C The system loses extra energy.
5246 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5253 c------------------------------------------------------------------------------
5254 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5255 implicit real*8 (a-h,o-z)
5256 include 'DIMENSIONS'
5257 include 'COMMON.IOUNITS'
5258 include 'COMMON.DERIV'
5259 include 'COMMON.INTERACT'
5260 include 'COMMON.CONTACTS'
5261 double precision gx(3),gx1(3)
5271 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5272 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5273 C Following 4 lines for diagnostics.
5278 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5280 c write (iout,*)'Contacts have occurred for peptide groups',
5281 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5282 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5283 C Calculate the multi-body contribution to energy.
5284 ecorr=ecorr+ekont*ees
5286 C Calculate multi-body contributions to the gradient.
5288 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5289 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5290 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5291 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5292 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5293 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5294 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5295 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5296 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5297 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5298 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5299 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5300 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5301 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5305 gradcorr(ll,m)=gradcorr(ll,m)+
5306 & ees*ekl*gacont_hbr(ll,jj,i)-
5307 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5308 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5313 gradcorr(ll,m)=gradcorr(ll,m)+
5314 & ees*eij*gacont_hbr(ll,kk,k)-
5315 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5316 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5323 C---------------------------------------------------------------------------
5324 subroutine dipole(i,j,jj)
5325 implicit real*8 (a-h,o-z)
5326 include 'DIMENSIONS'
5327 include 'DIMENSIONS.ZSCOPT'
5328 include 'COMMON.IOUNITS'
5329 include 'COMMON.CHAIN'
5330 include 'COMMON.FFIELD'
5331 include 'COMMON.DERIV'
5332 include 'COMMON.INTERACT'
5333 include 'COMMON.CONTACTS'
5334 include 'COMMON.TORSION'
5335 include 'COMMON.VAR'
5336 include 'COMMON.GEO'
5337 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5339 iti1 = itortyp(itype(i+1))
5340 if (j.lt.nres-1) then
5341 if (itype(j).le.ntyp) then
5342 itj1 = itortyp(itype(j+1))
5350 dipi(iii,1)=Ub2(iii,i)
5351 dipderi(iii)=Ub2der(iii,i)
5352 dipi(iii,2)=b1(iii,iti1)
5353 dipj(iii,1)=Ub2(iii,j)
5354 dipderj(iii)=Ub2der(iii,j)
5355 dipj(iii,2)=b1(iii,itj1)
5359 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5362 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5365 if (.not.calc_grad) return
5370 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5374 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5379 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5380 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5382 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5384 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5386 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5390 C---------------------------------------------------------------------------
5391 subroutine calc_eello(i,j,k,l,jj,kk)
5393 C This subroutine computes matrices and vectors needed to calculate
5394 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5396 implicit real*8 (a-h,o-z)
5397 include 'DIMENSIONS'
5398 include 'DIMENSIONS.ZSCOPT'
5399 include 'COMMON.IOUNITS'
5400 include 'COMMON.CHAIN'
5401 include 'COMMON.DERIV'
5402 include 'COMMON.INTERACT'
5403 include 'COMMON.CONTACTS'
5404 include 'COMMON.TORSION'
5405 include 'COMMON.VAR'
5406 include 'COMMON.GEO'
5407 include 'COMMON.FFIELD'
5408 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5409 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5412 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5413 cd & ' jj=',jj,' kk=',kk
5414 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5417 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5418 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5421 call transpose2(aa1(1,1),aa1t(1,1))
5422 call transpose2(aa2(1,1),aa2t(1,1))
5425 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5426 & aa1tder(1,1,lll,kkk))
5427 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5428 & aa2tder(1,1,lll,kkk))
5432 C parallel orientation of the two CA-CA-CA frames.
5433 if (i.gt.1 .and. itype(i).le.ntyp) then
5434 iti=itortyp(itype(i))
5438 itk1=itortyp(itype(k+1))
5439 itj=itortyp(itype(j))
5440 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5441 itl1=itortyp(itype(l+1))
5445 C A1 kernel(j+1) A2T
5447 cd write (iout,'(3f10.5,5x,3f10.5)')
5448 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5450 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5451 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5452 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5453 C Following matrices are needed only for 6-th order cumulants
5454 IF (wcorr6.gt.0.0d0) THEN
5455 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5456 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5457 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5458 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5459 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5460 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5461 & ADtEAderx(1,1,1,1,1,1))
5463 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5464 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5465 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5466 & ADtEA1derx(1,1,1,1,1,1))
5468 C End 6-th order cumulants
5471 cd write (2,*) 'In calc_eello6'
5473 cd write (2,*) 'iii=',iii
5475 cd write (2,*) 'kkk=',kkk
5477 cd write (2,'(3(2f10.5),5x)')
5478 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5483 call transpose2(EUgder(1,1,k),auxmat(1,1))
5484 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5485 call transpose2(EUg(1,1,k),auxmat(1,1))
5486 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5487 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5491 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5492 & EAEAderx(1,1,lll,kkk,iii,1))
5496 C A1T kernel(i+1) A2
5497 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5498 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5499 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5500 C Following matrices are needed only for 6-th order cumulants
5501 IF (wcorr6.gt.0.0d0) THEN
5502 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5503 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5504 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5505 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5506 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5507 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5508 & ADtEAderx(1,1,1,1,1,2))
5509 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5510 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5511 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5512 & ADtEA1derx(1,1,1,1,1,2))
5514 C End 6-th order cumulants
5515 call transpose2(EUgder(1,1,l),auxmat(1,1))
5516 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5517 call transpose2(EUg(1,1,l),auxmat(1,1))
5518 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5519 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5523 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5524 & EAEAderx(1,1,lll,kkk,iii,2))
5529 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5530 C They are needed only when the fifth- or the sixth-order cumulants are
5532 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5533 call transpose2(AEA(1,1,1),auxmat(1,1))
5534 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5535 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5536 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5537 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5538 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5539 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5540 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5541 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5542 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5543 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5544 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5545 call transpose2(AEA(1,1,2),auxmat(1,1))
5546 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5547 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5548 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5549 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5550 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5551 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5552 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5553 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5554 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5555 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5556 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5557 C Calculate the Cartesian derivatives of the vectors.
5561 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5562 call matvec2(auxmat(1,1),b1(1,iti),
5563 & AEAb1derx(1,lll,kkk,iii,1,1))
5564 call matvec2(auxmat(1,1),Ub2(1,i),
5565 & AEAb2derx(1,lll,kkk,iii,1,1))
5566 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5567 & AEAb1derx(1,lll,kkk,iii,2,1))
5568 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5569 & AEAb2derx(1,lll,kkk,iii,2,1))
5570 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5571 call matvec2(auxmat(1,1),b1(1,itj),
5572 & AEAb1derx(1,lll,kkk,iii,1,2))
5573 call matvec2(auxmat(1,1),Ub2(1,j),
5574 & AEAb2derx(1,lll,kkk,iii,1,2))
5575 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5576 & AEAb1derx(1,lll,kkk,iii,2,2))
5577 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5578 & AEAb2derx(1,lll,kkk,iii,2,2))
5585 C Antiparallel orientation of the two CA-CA-CA frames.
5586 if (i.gt.1 .and. itype(i).le.ntyp) then
5587 iti=itortyp(itype(i))
5591 itk1=itortyp(itype(k+1))
5592 itl=itortyp(itype(l))
5593 itj=itortyp(itype(j))
5594 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5595 itj1=itortyp(itype(j+1))
5599 C A2 kernel(j-1)T A1T
5600 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5601 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5602 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5603 C Following matrices are needed only for 6-th order cumulants
5604 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5605 & j.eq.i+4 .and. l.eq.i+3)) THEN
5606 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5607 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5608 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5609 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5610 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5611 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5612 & ADtEAderx(1,1,1,1,1,1))
5613 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5614 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5615 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5616 & ADtEA1derx(1,1,1,1,1,1))
5618 C End 6-th order cumulants
5619 call transpose2(EUgder(1,1,k),auxmat(1,1))
5620 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5621 call transpose2(EUg(1,1,k),auxmat(1,1))
5622 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5623 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5627 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5628 & EAEAderx(1,1,lll,kkk,iii,1))
5632 C A2T kernel(i+1)T A1
5633 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5634 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5635 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5636 C Following matrices are needed only for 6-th order cumulants
5637 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5638 & j.eq.i+4 .and. l.eq.i+3)) THEN
5639 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5640 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5641 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5642 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5643 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5644 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5645 & ADtEAderx(1,1,1,1,1,2))
5646 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5647 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5648 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5649 & ADtEA1derx(1,1,1,1,1,2))
5651 C End 6-th order cumulants
5652 call transpose2(EUgder(1,1,j),auxmat(1,1))
5653 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5654 call transpose2(EUg(1,1,j),auxmat(1,1))
5655 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5656 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5660 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5661 & EAEAderx(1,1,lll,kkk,iii,2))
5666 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5667 C They are needed only when the fifth- or the sixth-order cumulants are
5669 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5670 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5671 call transpose2(AEA(1,1,1),auxmat(1,1))
5672 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5673 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5674 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5675 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5676 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5677 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5678 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5679 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5680 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5681 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5682 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5683 call transpose2(AEA(1,1,2),auxmat(1,1))
5684 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5685 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5686 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5687 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5688 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5689 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5690 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5691 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5692 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5693 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5694 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5695 C Calculate the Cartesian derivatives of the vectors.
5699 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5700 call matvec2(auxmat(1,1),b1(1,iti),
5701 & AEAb1derx(1,lll,kkk,iii,1,1))
5702 call matvec2(auxmat(1,1),Ub2(1,i),
5703 & AEAb2derx(1,lll,kkk,iii,1,1))
5704 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5705 & AEAb1derx(1,lll,kkk,iii,2,1))
5706 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5707 & AEAb2derx(1,lll,kkk,iii,2,1))
5708 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5709 call matvec2(auxmat(1,1),b1(1,itl),
5710 & AEAb1derx(1,lll,kkk,iii,1,2))
5711 call matvec2(auxmat(1,1),Ub2(1,l),
5712 & AEAb2derx(1,lll,kkk,iii,1,2))
5713 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5714 & AEAb1derx(1,lll,kkk,iii,2,2))
5715 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5716 & AEAb2derx(1,lll,kkk,iii,2,2))
5725 C---------------------------------------------------------------------------
5726 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5727 & KK,KKderg,AKA,AKAderg,AKAderx)
5731 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5732 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5733 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5738 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5740 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5743 cd if (lprn) write (2,*) 'In kernel'
5745 cd if (lprn) write (2,*) 'kkk=',kkk
5747 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5748 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5750 cd write (2,*) 'lll=',lll
5751 cd write (2,*) 'iii=1'
5753 cd write (2,'(3(2f10.5),5x)')
5754 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5757 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5758 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5760 cd write (2,*) 'lll=',lll
5761 cd write (2,*) 'iii=2'
5763 cd write (2,'(3(2f10.5),5x)')
5764 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5771 C---------------------------------------------------------------------------
5772 double precision function eello4(i,j,k,l,jj,kk)
5773 implicit real*8 (a-h,o-z)
5774 include 'DIMENSIONS'
5775 include 'DIMENSIONS.ZSCOPT'
5776 include 'COMMON.IOUNITS'
5777 include 'COMMON.CHAIN'
5778 include 'COMMON.DERIV'
5779 include 'COMMON.INTERACT'
5780 include 'COMMON.CONTACTS'
5781 include 'COMMON.TORSION'
5782 include 'COMMON.VAR'
5783 include 'COMMON.GEO'
5784 double precision pizda(2,2),ggg1(3),ggg2(3)
5785 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5789 cd print *,'eello4:',i,j,k,l,jj,kk
5790 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5791 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5792 cold eij=facont_hb(jj,i)
5793 cold ekl=facont_hb(kk,k)
5795 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5797 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5798 gcorr_loc(k-1)=gcorr_loc(k-1)
5799 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5801 gcorr_loc(l-1)=gcorr_loc(l-1)
5802 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5804 gcorr_loc(j-1)=gcorr_loc(j-1)
5805 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5810 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5811 & -EAEAderx(2,2,lll,kkk,iii,1)
5812 cd derx(lll,kkk,iii)=0.0d0
5816 cd gcorr_loc(l-1)=0.0d0
5817 cd gcorr_loc(j-1)=0.0d0
5818 cd gcorr_loc(k-1)=0.0d0
5820 cd write (iout,*)'Contacts have occurred for peptide groups',
5821 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5822 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5823 if (j.lt.nres-1) then
5830 if (l.lt.nres-1) then
5838 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5839 ggg1(ll)=eel4*g_contij(ll,1)
5840 ggg2(ll)=eel4*g_contij(ll,2)
5841 ghalf=0.5d0*ggg1(ll)
5843 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5844 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5845 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5846 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5847 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5848 ghalf=0.5d0*ggg2(ll)
5850 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5851 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5852 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5853 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5858 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5859 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5864 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5865 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5871 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5876 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5880 cd write (2,*) iii,gcorr_loc(iii)
5884 cd write (2,*) 'ekont',ekont
5885 cd write (iout,*) 'eello4',ekont*eel4
5888 C---------------------------------------------------------------------------
5889 double precision function eello5(i,j,k,l,jj,kk)
5890 implicit real*8 (a-h,o-z)
5891 include 'DIMENSIONS'
5892 include 'DIMENSIONS.ZSCOPT'
5893 include 'COMMON.IOUNITS'
5894 include 'COMMON.CHAIN'
5895 include 'COMMON.DERIV'
5896 include 'COMMON.INTERACT'
5897 include 'COMMON.CONTACTS'
5898 include 'COMMON.TORSION'
5899 include 'COMMON.VAR'
5900 include 'COMMON.GEO'
5901 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5902 double precision ggg1(3),ggg2(3)
5903 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5908 C /l\ / \ \ / \ / \ / C
5909 C / \ / \ \ / \ / \ / C
5910 C j| o |l1 | o | o| o | | o |o C
5911 C \ |/k\| |/ \| / |/ \| |/ \| C
5912 C \i/ \ / \ / / \ / \ C
5914 C (I) (II) (III) (IV) C
5916 C eello5_1 eello5_2 eello5_3 eello5_4 C
5918 C Antiparallel chains C
5921 C /j\ / \ \ / \ / \ / C
5922 C / \ / \ \ / \ / \ / C
5923 C j1| o |l | o | o| o | | o |o C
5924 C \ |/k\| |/ \| / |/ \| |/ \| C
5925 C \i/ \ / \ / / \ / \ C
5927 C (I) (II) (III) (IV) C
5929 C eello5_1 eello5_2 eello5_3 eello5_4 C
5931 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5933 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5934 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5939 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5941 itk=itortyp(itype(k))
5942 itl=itortyp(itype(l))
5943 itj=itortyp(itype(j))
5948 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5949 cd & eel5_3_num,eel5_4_num)
5953 derx(lll,kkk,iii)=0.0d0
5957 cd eij=facont_hb(jj,i)
5958 cd ekl=facont_hb(kk,k)
5960 cd write (iout,*)'Contacts have occurred for peptide groups',
5961 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5963 C Contribution from the graph I.
5964 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5965 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5966 call transpose2(EUg(1,1,k),auxmat(1,1))
5967 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5968 vv(1)=pizda(1,1)-pizda(2,2)
5969 vv(2)=pizda(1,2)+pizda(2,1)
5970 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5971 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5973 C Explicit gradient in virtual-dihedral angles.
5974 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5975 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5976 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5977 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5978 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5979 vv(1)=pizda(1,1)-pizda(2,2)
5980 vv(2)=pizda(1,2)+pizda(2,1)
5981 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5982 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5983 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5984 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5985 vv(1)=pizda(1,1)-pizda(2,2)
5986 vv(2)=pizda(1,2)+pizda(2,1)
5988 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5989 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5990 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5992 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5993 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5994 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5996 C Cartesian gradient
6000 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6002 vv(1)=pizda(1,1)-pizda(2,2)
6003 vv(2)=pizda(1,2)+pizda(2,1)
6004 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6005 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6006 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6013 C Contribution from graph II
6014 call transpose2(EE(1,1,itk),auxmat(1,1))
6015 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6016 vv(1)=pizda(1,1)+pizda(2,2)
6017 vv(2)=pizda(2,1)-pizda(1,2)
6018 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6019 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6021 C Explicit gradient in virtual-dihedral angles.
6022 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6023 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6024 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6025 vv(1)=pizda(1,1)+pizda(2,2)
6026 vv(2)=pizda(2,1)-pizda(1,2)
6028 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6029 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6030 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6032 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6033 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6034 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6036 C Cartesian gradient
6040 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6042 vv(1)=pizda(1,1)+pizda(2,2)
6043 vv(2)=pizda(2,1)-pizda(1,2)
6044 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6045 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6046 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6055 C Parallel orientation
6056 C Contribution from graph III
6057 call transpose2(EUg(1,1,l),auxmat(1,1))
6058 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6059 vv(1)=pizda(1,1)-pizda(2,2)
6060 vv(2)=pizda(1,2)+pizda(2,1)
6061 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6062 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6064 C Explicit gradient in virtual-dihedral angles.
6065 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6066 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6067 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6068 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6069 vv(1)=pizda(1,1)-pizda(2,2)
6070 vv(2)=pizda(1,2)+pizda(2,1)
6071 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6072 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6073 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6074 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6075 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6076 vv(1)=pizda(1,1)-pizda(2,2)
6077 vv(2)=pizda(1,2)+pizda(2,1)
6078 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6079 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6080 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6081 C Cartesian gradient
6085 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6087 vv(1)=pizda(1,1)-pizda(2,2)
6088 vv(2)=pizda(1,2)+pizda(2,1)
6089 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6090 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6091 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6097 C Contribution from graph IV
6099 call transpose2(EE(1,1,itl),auxmat(1,1))
6100 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6101 vv(1)=pizda(1,1)+pizda(2,2)
6102 vv(2)=pizda(2,1)-pizda(1,2)
6103 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6104 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6106 C Explicit gradient in virtual-dihedral angles.
6107 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6108 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6109 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6110 vv(1)=pizda(1,1)+pizda(2,2)
6111 vv(2)=pizda(2,1)-pizda(1,2)
6112 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6113 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6114 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6115 C Cartesian gradient
6119 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6121 vv(1)=pizda(1,1)+pizda(2,2)
6122 vv(2)=pizda(2,1)-pizda(1,2)
6123 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6124 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6125 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6131 C Antiparallel orientation
6132 C Contribution from graph III
6134 call transpose2(EUg(1,1,j),auxmat(1,1))
6135 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6136 vv(1)=pizda(1,1)-pizda(2,2)
6137 vv(2)=pizda(1,2)+pizda(2,1)
6138 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6139 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6141 C Explicit gradient in virtual-dihedral angles.
6142 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6143 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6144 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6145 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6146 vv(1)=pizda(1,1)-pizda(2,2)
6147 vv(2)=pizda(1,2)+pizda(2,1)
6148 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6149 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6150 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6151 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6152 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6153 vv(1)=pizda(1,1)-pizda(2,2)
6154 vv(2)=pizda(1,2)+pizda(2,1)
6155 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6156 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6157 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6158 C Cartesian gradient
6162 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6164 vv(1)=pizda(1,1)-pizda(2,2)
6165 vv(2)=pizda(1,2)+pizda(2,1)
6166 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6167 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6168 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6174 C Contribution from graph IV
6176 call transpose2(EE(1,1,itj),auxmat(1,1))
6177 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6178 vv(1)=pizda(1,1)+pizda(2,2)
6179 vv(2)=pizda(2,1)-pizda(1,2)
6180 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6181 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6183 C Explicit gradient in virtual-dihedral angles.
6184 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6185 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6186 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6187 vv(1)=pizda(1,1)+pizda(2,2)
6188 vv(2)=pizda(2,1)-pizda(1,2)
6189 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6190 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6191 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6192 C Cartesian gradient
6196 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6198 vv(1)=pizda(1,1)+pizda(2,2)
6199 vv(2)=pizda(2,1)-pizda(1,2)
6200 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6201 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6202 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6209 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6210 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6211 cd write (2,*) 'ijkl',i,j,k,l
6212 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6213 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6215 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6216 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6217 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6218 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6220 if (j.lt.nres-1) then
6227 if (l.lt.nres-1) then
6237 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6239 ggg1(ll)=eel5*g_contij(ll,1)
6240 ggg2(ll)=eel5*g_contij(ll,2)
6241 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6242 ghalf=0.5d0*ggg1(ll)
6244 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6245 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6246 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6247 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6248 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6249 ghalf=0.5d0*ggg2(ll)
6251 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6252 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6253 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6254 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6259 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6260 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6265 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6266 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6272 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6277 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6281 cd write (2,*) iii,g_corr5_loc(iii)
6285 cd write (2,*) 'ekont',ekont
6286 cd write (iout,*) 'eello5',ekont*eel5
6289 c--------------------------------------------------------------------------
6290 double precision function eello6(i,j,k,l,jj,kk)
6291 implicit real*8 (a-h,o-z)
6292 include 'DIMENSIONS'
6293 include 'DIMENSIONS.ZSCOPT'
6294 include 'COMMON.IOUNITS'
6295 include 'COMMON.CHAIN'
6296 include 'COMMON.DERIV'
6297 include 'COMMON.INTERACT'
6298 include 'COMMON.CONTACTS'
6299 include 'COMMON.TORSION'
6300 include 'COMMON.VAR'
6301 include 'COMMON.GEO'
6302 include 'COMMON.FFIELD'
6303 double precision ggg1(3),ggg2(3)
6304 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6309 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6317 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6318 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6322 derx(lll,kkk,iii)=0.0d0
6326 cd eij=facont_hb(jj,i)
6327 cd ekl=facont_hb(kk,k)
6333 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6334 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6335 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6336 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6337 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6338 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6340 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6341 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6342 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6343 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6344 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6345 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6349 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6351 C If turn contributions are considered, they will be handled separately.
6352 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6353 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6354 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6355 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6356 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6357 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6358 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6361 if (j.lt.nres-1) then
6368 if (l.lt.nres-1) then
6376 ggg1(ll)=eel6*g_contij(ll,1)
6377 ggg2(ll)=eel6*g_contij(ll,2)
6378 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6379 ghalf=0.5d0*ggg1(ll)
6381 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6382 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6383 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6384 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6385 ghalf=0.5d0*ggg2(ll)
6386 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6388 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6389 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6390 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6391 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6396 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6397 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6402 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6403 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6409 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6414 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6418 cd write (2,*) iii,g_corr6_loc(iii)
6422 cd write (2,*) 'ekont',ekont
6423 cd write (iout,*) 'eello6',ekont*eel6
6426 c--------------------------------------------------------------------------
6427 double precision function eello6_graph1(i,j,k,l,imat,swap)
6428 implicit real*8 (a-h,o-z)
6429 include 'DIMENSIONS'
6430 include 'DIMENSIONS.ZSCOPT'
6431 include 'COMMON.IOUNITS'
6432 include 'COMMON.CHAIN'
6433 include 'COMMON.DERIV'
6434 include 'COMMON.INTERACT'
6435 include 'COMMON.CONTACTS'
6436 include 'COMMON.TORSION'
6437 include 'COMMON.VAR'
6438 include 'COMMON.GEO'
6439 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6443 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6445 C Parallel Antiparallel C
6451 C \ j|/k\| / \ |/k\|l / C
6456 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6457 itk=itortyp(itype(k))
6458 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6459 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6460 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6461 call transpose2(EUgC(1,1,k),auxmat(1,1))
6462 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6463 vv1(1)=pizda1(1,1)-pizda1(2,2)
6464 vv1(2)=pizda1(1,2)+pizda1(2,1)
6465 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6466 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6467 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6468 s5=scalar2(vv(1),Dtobr2(1,i))
6469 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6470 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6471 if (.not. calc_grad) return
6472 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6473 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6474 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6475 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6476 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6477 & +scalar2(vv(1),Dtobr2der(1,i)))
6478 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6479 vv1(1)=pizda1(1,1)-pizda1(2,2)
6480 vv1(2)=pizda1(1,2)+pizda1(2,1)
6481 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6482 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6484 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6485 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6486 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6487 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6488 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6490 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6491 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6492 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6493 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6494 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6496 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6497 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6498 vv1(1)=pizda1(1,1)-pizda1(2,2)
6499 vv1(2)=pizda1(1,2)+pizda1(2,1)
6500 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6501 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6502 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6503 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6512 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6513 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6514 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6515 call transpose2(EUgC(1,1,k),auxmat(1,1))
6516 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6518 vv1(1)=pizda1(1,1)-pizda1(2,2)
6519 vv1(2)=pizda1(1,2)+pizda1(2,1)
6520 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6521 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6522 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6523 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6524 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6525 s5=scalar2(vv(1),Dtobr2(1,i))
6526 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6532 c----------------------------------------------------------------------------
6533 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6534 implicit real*8 (a-h,o-z)
6535 include 'DIMENSIONS'
6536 include 'DIMENSIONS.ZSCOPT'
6537 include 'COMMON.IOUNITS'
6538 include 'COMMON.CHAIN'
6539 include 'COMMON.DERIV'
6540 include 'COMMON.INTERACT'
6541 include 'COMMON.CONTACTS'
6542 include 'COMMON.TORSION'
6543 include 'COMMON.VAR'
6544 include 'COMMON.GEO'
6546 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6547 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6550 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6552 C Parallel Antiparallel C
6558 C \ j|/k\| \ |/k\|l C
6563 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6564 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6565 C AL 7/4/01 s1 would occur in the sixth-order moment,
6566 C but not in a cluster cumulant
6568 s1=dip(1,jj,i)*dip(1,kk,k)
6570 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6571 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6572 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6573 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6574 call transpose2(EUg(1,1,k),auxmat(1,1))
6575 call matmat2(ADtEA1(1,1,1),auxmat(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))
6579 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6581 eello6_graph2=-(s1+s2+s3+s4)
6583 eello6_graph2=-(s2+s3+s4)
6586 if (.not. calc_grad) return
6587 C Derivatives in gamma(i-1)
6590 s1=dipderg(1,jj,i)*dip(1,kk,k)
6592 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6593 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6594 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6595 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6597 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6599 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6601 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6603 C Derivatives in gamma(k-1)
6605 s1=dip(1,jj,i)*dipderg(1,kk,k)
6607 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6608 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6609 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6610 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6611 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6612 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6613 vv(1)=pizda(1,1)-pizda(2,2)
6614 vv(2)=pizda(1,2)+pizda(2,1)
6615 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6617 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6619 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6621 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6622 C Derivatives in gamma(j-1) or gamma(l-1)
6625 s1=dipderg(3,jj,i)*dip(1,kk,k)
6627 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6628 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6629 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6630 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6631 vv(1)=pizda(1,1)-pizda(2,2)
6632 vv(2)=pizda(1,2)+pizda(2,1)
6633 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6636 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6638 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6641 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6642 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6644 C Derivatives in gamma(l-1) or gamma(j-1)
6647 s1=dip(1,jj,i)*dipderg(3,kk,k)
6649 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6650 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6651 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6652 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6653 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6654 vv(1)=pizda(1,1)-pizda(2,2)
6655 vv(2)=pizda(1,2)+pizda(2,1)
6656 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6659 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6661 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6664 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6665 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6667 C Cartesian derivatives.
6669 write (2,*) 'In eello6_graph2'
6671 write (2,*) 'iii=',iii
6673 write (2,*) 'kkk=',kkk
6675 write (2,'(3(2f10.5),5x)')
6676 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6686 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6688 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6691 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6693 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6694 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6696 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6697 call transpose2(EUg(1,1,k),auxmat(1,1))
6698 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6700 vv(1)=pizda(1,1)-pizda(2,2)
6701 vv(2)=pizda(1,2)+pizda(2,1)
6702 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6703 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6705 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6707 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6710 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6712 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6719 c----------------------------------------------------------------------------
6720 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6721 implicit real*8 (a-h,o-z)
6722 include 'DIMENSIONS'
6723 include 'DIMENSIONS.ZSCOPT'
6724 include 'COMMON.IOUNITS'
6725 include 'COMMON.CHAIN'
6726 include 'COMMON.DERIV'
6727 include 'COMMON.INTERACT'
6728 include 'COMMON.CONTACTS'
6729 include 'COMMON.TORSION'
6730 include 'COMMON.VAR'
6731 include 'COMMON.GEO'
6732 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6734 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6736 C Parallel Antiparallel C
6742 C j|/k\| / |/k\|l / C
6747 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6749 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6750 C energy moment and not to the cluster cumulant.
6751 iti=itortyp(itype(i))
6752 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6753 itj1=itortyp(itype(j+1))
6757 itk=itortyp(itype(k))
6758 itk1=itortyp(itype(k+1))
6759 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6760 itl1=itortyp(itype(l+1))
6765 s1=dip(4,jj,i)*dip(4,kk,k)
6767 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6768 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6769 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6770 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6771 call transpose2(EE(1,1,itk),auxmat(1,1))
6772 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6773 vv(1)=pizda(1,1)+pizda(2,2)
6774 vv(2)=pizda(2,1)-pizda(1,2)
6775 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6776 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6778 eello6_graph3=-(s1+s2+s3+s4)
6780 eello6_graph3=-(s2+s3+s4)
6783 if (.not. calc_grad) return
6784 C Derivatives in gamma(k-1)
6785 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6786 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6787 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6788 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6789 C Derivatives in gamma(l-1)
6790 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6791 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6792 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6793 vv(1)=pizda(1,1)+pizda(2,2)
6794 vv(2)=pizda(2,1)-pizda(1,2)
6795 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6796 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6797 C Cartesian derivatives.
6803 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6805 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6808 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6810 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6811 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6813 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6814 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6816 vv(1)=pizda(1,1)+pizda(2,2)
6817 vv(2)=pizda(2,1)-pizda(1,2)
6818 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6820 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6822 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6825 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6827 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6829 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6835 c----------------------------------------------------------------------------
6836 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6837 implicit real*8 (a-h,o-z)
6838 include 'DIMENSIONS'
6839 include 'DIMENSIONS.ZSCOPT'
6840 include 'COMMON.IOUNITS'
6841 include 'COMMON.CHAIN'
6842 include 'COMMON.DERIV'
6843 include 'COMMON.INTERACT'
6844 include 'COMMON.CONTACTS'
6845 include 'COMMON.TORSION'
6846 include 'COMMON.VAR'
6847 include 'COMMON.GEO'
6848 include 'COMMON.FFIELD'
6849 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6850 & auxvec1(2),auxmat1(2,2)
6852 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6854 C Parallel Antiparallel C
6860 C \ j|/k\| \ |/k\|l C
6865 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6867 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6868 C energy moment and not to the cluster cumulant.
6869 cd write (2,*) 'eello_graph4: wturn6',wturn6
6870 iti=itortyp(itype(i))
6871 itj=itortyp(itype(j))
6872 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6873 itj1=itortyp(itype(j+1))
6877 itk=itortyp(itype(k))
6878 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6879 itk1=itortyp(itype(k+1))
6883 itl=itortyp(itype(l))
6884 if (l.lt.nres-1) then
6885 itl1=itortyp(itype(l+1))
6889 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6890 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6891 cd & ' itl',itl,' itl1',itl1
6894 s1=dip(3,jj,i)*dip(3,kk,k)
6896 s1=dip(2,jj,j)*dip(2,kk,l)
6899 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6900 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6902 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6903 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6905 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6906 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6908 call transpose2(EUg(1,1,k),auxmat(1,1))
6909 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6910 vv(1)=pizda(1,1)-pizda(2,2)
6911 vv(2)=pizda(2,1)+pizda(1,2)
6912 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6913 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6915 eello6_graph4=-(s1+s2+s3+s4)
6917 eello6_graph4=-(s2+s3+s4)
6919 if (.not. calc_grad) return
6920 C Derivatives in gamma(i-1)
6924 s1=dipderg(2,jj,i)*dip(3,kk,k)
6926 s1=dipderg(4,jj,j)*dip(2,kk,l)
6929 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6931 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6932 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6934 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6935 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6937 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6938 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6939 cd write (2,*) 'turn6 derivatives'
6941 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6943 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6947 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6949 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6953 C Derivatives in gamma(k-1)
6956 s1=dip(3,jj,i)*dipderg(2,kk,k)
6958 s1=dip(2,jj,j)*dipderg(4,kk,l)
6961 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6962 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6964 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6965 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6967 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6968 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6970 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6971 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6972 vv(1)=pizda(1,1)-pizda(2,2)
6973 vv(2)=pizda(2,1)+pizda(1,2)
6974 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6975 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6977 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6979 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6983 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6985 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6988 C Derivatives in gamma(j-1) or gamma(l-1)
6989 if (l.eq.j+1 .and. l.gt.1) then
6990 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6991 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6992 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6993 vv(1)=pizda(1,1)-pizda(2,2)
6994 vv(2)=pizda(2,1)+pizda(1,2)
6995 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6996 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6997 else if (j.gt.1) then
6998 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6999 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7000 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7001 vv(1)=pizda(1,1)-pizda(2,2)
7002 vv(2)=pizda(2,1)+pizda(1,2)
7003 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7004 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7005 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7007 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7010 C Cartesian derivatives.
7017 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7019 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7023 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7025 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7029 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7031 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7033 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7034 & b1(1,itj1),auxvec(1))
7035 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7037 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7038 & b1(1,itl1),auxvec(1))
7039 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7041 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7043 vv(1)=pizda(1,1)-pizda(2,2)
7044 vv(2)=pizda(2,1)+pizda(1,2)
7045 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7047 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7049 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7052 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7055 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7058 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7060 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7062 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7066 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7068 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7071 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7073 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7081 c----------------------------------------------------------------------------
7082 double precision function eello_turn6(i,jj,kk)
7083 implicit real*8 (a-h,o-z)
7084 include 'DIMENSIONS'
7085 include 'DIMENSIONS.ZSCOPT'
7086 include 'COMMON.IOUNITS'
7087 include 'COMMON.CHAIN'
7088 include 'COMMON.DERIV'
7089 include 'COMMON.INTERACT'
7090 include 'COMMON.CONTACTS'
7091 include 'COMMON.TORSION'
7092 include 'COMMON.VAR'
7093 include 'COMMON.GEO'
7094 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7095 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7097 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7098 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7099 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7100 C the respective energy moment and not to the cluster cumulant.
7105 iti=itortyp(itype(i))
7106 itk=itortyp(itype(k))
7107 itk1=itortyp(itype(k+1))
7108 itl=itortyp(itype(l))
7109 itj=itortyp(itype(j))
7110 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7111 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7112 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7117 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7119 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7123 derx_turn(lll,kkk,iii)=0.0d0
7130 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7132 cd write (2,*) 'eello6_5',eello6_5
7134 call transpose2(AEA(1,1,1),auxmat(1,1))
7135 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7136 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7137 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7141 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7142 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7143 s2 = scalar2(b1(1,itk),vtemp1(1))
7145 call transpose2(AEA(1,1,2),atemp(1,1))
7146 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7147 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7148 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7152 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7153 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7154 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7156 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7157 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7158 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7159 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7160 ss13 = scalar2(b1(1,itk),vtemp4(1))
7161 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7165 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7171 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7173 C Derivatives in gamma(i+2)
7175 call transpose2(AEA(1,1,1),auxmatd(1,1))
7176 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7177 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7178 call transpose2(AEAderg(1,1,2),atempd(1,1))
7179 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7180 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7184 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7185 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7186 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7192 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7193 C Derivatives in gamma(i+3)
7195 call transpose2(AEA(1,1,1),auxmatd(1,1))
7196 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7197 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7198 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7202 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7203 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7204 s2d = scalar2(b1(1,itk),vtemp1d(1))
7206 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7207 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7209 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7211 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7212 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7213 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7223 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7224 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7226 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7227 & -0.5d0*ekont*(s2d+s12d)
7229 C Derivatives in gamma(i+4)
7230 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7231 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7232 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7234 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7235 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7236 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7246 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7248 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7250 C Derivatives in gamma(i+5)
7252 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7253 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7254 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7258 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7259 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7260 s2d = scalar2(b1(1,itk),vtemp1d(1))
7262 call transpose2(AEA(1,1,2),atempd(1,1))
7263 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7264 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7268 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7269 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7271 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7272 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7273 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7283 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7284 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7286 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7287 & -0.5d0*ekont*(s2d+s12d)
7289 C Cartesian derivatives
7294 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7295 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7296 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7300 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7301 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7303 s2d = scalar2(b1(1,itk),vtemp1d(1))
7305 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7306 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7307 s8d = -(atempd(1,1)+atempd(2,2))*
7308 & scalar2(cc(1,1,itl),vtemp2(1))
7312 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7314 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7315 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7322 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7325 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7329 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7330 & - 0.5d0*(s8d+s12d)
7332 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7341 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7343 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7344 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7345 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7346 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7347 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7349 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7350 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7351 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7355 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7356 cd & 16*eel_turn6_num
7358 if (j.lt.nres-1) then
7365 if (l.lt.nres-1) then
7373 ggg1(ll)=eel_turn6*g_contij(ll,1)
7374 ggg2(ll)=eel_turn6*g_contij(ll,2)
7375 ghalf=0.5d0*ggg1(ll)
7377 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7378 & +ekont*derx_turn(ll,2,1)
7379 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7380 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7381 & +ekont*derx_turn(ll,4,1)
7382 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7383 ghalf=0.5d0*ggg2(ll)
7385 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7386 & +ekont*derx_turn(ll,2,2)
7387 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7388 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7389 & +ekont*derx_turn(ll,4,2)
7390 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7395 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7400 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7406 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7411 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7415 cd write (2,*) iii,g_corr6_loc(iii)
7418 eello_turn6=ekont*eel_turn6
7419 cd write (2,*) 'ekont',ekont
7420 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7423 crc-------------------------------------------------
7424 SUBROUTINE MATVEC2(A1,V1,V2)
7425 implicit real*8 (a-h,o-z)
7426 include 'DIMENSIONS'
7427 DIMENSION A1(2,2),V1(2),V2(2)
7431 c 3 VI=VI+A1(I,K)*V1(K)
7435 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7436 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7441 C---------------------------------------
7442 SUBROUTINE MATMAT2(A1,A2,A3)
7443 implicit real*8 (a-h,o-z)
7444 include 'DIMENSIONS'
7445 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7446 c DIMENSION AI3(2,2)
7450 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7456 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7457 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7458 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7459 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7467 c-------------------------------------------------------------------------
7468 double precision function scalar2(u,v)
7470 double precision u(2),v(2)
7473 scalar2=u(1)*v(1)+u(2)*v(2)
7477 C-----------------------------------------------------------------------------
7479 subroutine transpose2(a,at)
7481 double precision a(2,2),at(2,2)
7488 c--------------------------------------------------------------------------
7489 subroutine transpose(n,a,at)
7492 double precision a(n,n),at(n,n)
7500 C---------------------------------------------------------------------------
7501 subroutine prodmat3(a1,a2,kk,transp,prod)
7504 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7506 crc double precision auxmat(2,2),prod_(2,2)
7509 crc call transpose2(kk(1,1),auxmat(1,1))
7510 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7511 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7513 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7514 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7515 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7516 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7517 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7518 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7519 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7520 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7523 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7524 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7526 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7527 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7528 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7529 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7530 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7531 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7532 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7533 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7536 c call transpose2(a2(1,1),a2t(1,1))
7539 crc print *,((prod_(i,j),i=1,2),j=1,2)
7540 crc print *,((prod(i,j),i=1,2),j=1,2)
7544 C-----------------------------------------------------------------------------
7545 double precision function scalar(u,v)
7547 double precision u(3),v(3)