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+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+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
157 if (dyn_ss) call dyn_set_nss
161 if (isnan(etot).ne.0) energia(0)=1.0d+99
163 if (isnan(etot)) energia(0)=1.0d+99
168 idumm=proc_proc(etot,i)
170 call proc_proc(etot,i)
172 if(i.eq.1)energia(0)=1.0d+99
179 C Sum up the components of the Cartesian gradient.
184 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
185 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
187 & wstrain*ghpbc(j,i)+
188 & wcorr*fact(3)*gradcorr(j,i)+
189 & wel_loc*fact(2)*gel_loc(j,i)+
190 & wturn3*fact(2)*gcorr3_turn(j,i)+
191 & wturn4*fact(3)*gcorr4_turn(j,i)+
192 & wcorr5*fact(4)*gradcorr5(j,i)+
193 & wcorr6*fact(5)*gradcorr6(j,i)+
194 & wturn6*fact(5)*gcorr6_turn(j,i)+
195 & wsccor*fact(2)*gsccorc(j,i)
196 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
198 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
199 & wsccor*fact(2)*gsccorx(j,i)
204 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
205 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
207 & wcorr*fact(3)*gradcorr(j,i)+
208 & wel_loc*fact(2)*gel_loc(j,i)+
209 & wturn3*fact(2)*gcorr3_turn(j,i)+
210 & wturn4*fact(3)*gcorr4_turn(j,i)+
211 & wcorr5*fact(4)*gradcorr5(j,i)+
212 & wcorr6*fact(5)*gradcorr6(j,i)+
213 & wturn6*fact(5)*gcorr6_turn(j,i)+
214 & wsccor*fact(2)*gsccorc(j,i)
215 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
217 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
218 & wsccor*fact(1)*gsccorx(j,i)
225 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
226 & +wcorr5*fact(4)*g_corr5_loc(i)
227 & +wcorr6*fact(5)*g_corr6_loc(i)
228 & +wturn4*fact(3)*gel_loc_turn4(i)
229 & +wturn3*fact(2)*gel_loc_turn3(i)
230 & +wturn6*fact(5)*gel_loc_turn6(i)
231 & +wel_loc*fact(2)*gel_loc_loc(i)
232 & +wsccor*fact(1)*gsccor_loc(i)
237 C------------------------------------------------------------------------
238 subroutine enerprint(energia,fact)
239 implicit real*8 (a-h,o-z)
241 include 'DIMENSIONS.ZSCOPT'
242 include 'COMMON.IOUNITS'
243 include 'COMMON.FFIELD'
244 include 'COMMON.SBRIDGE'
245 double precision energia(0:max_ene),fact(6)
247 evdw=energia(1)+fact(6)*energia(21)
249 evdw2=energia(2)+energia(17)
261 eello_turn3=energia(8)
262 eello_turn4=energia(9)
263 eello_turn6=energia(10)
270 edihcnstr=energia(20)
273 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
275 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
276 & etors_d,wtor_d*fact(2),ehpb,wstrain,
277 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
278 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
279 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
280 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
281 10 format (/'Virtual-chain energies:'//
282 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
283 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
284 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
285 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
286 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
287 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
288 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
289 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
290 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
291 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
292 & ' (SS bridges & dist. cnstr.)'/
293 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
297 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
298 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
299 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
300 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
301 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
302 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
303 & 'ETOT= ',1pE16.6,' (total)')
305 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
306 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
307 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
308 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
309 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
310 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
311 & edihcnstr,ebr*nss,etot
312 10 format (/'Virtual-chain energies:'//
313 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
314 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
315 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
316 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
317 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
318 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
319 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
320 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
321 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
322 & ' (SS bridges & dist. cnstr.)'/
323 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
327 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
328 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
329 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
330 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
331 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
332 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
333 & 'ETOT= ',1pE16.6,' (total)')
337 C-----------------------------------------------------------------------
338 subroutine elj(evdw,evdw_t)
340 C This subroutine calculates the interaction energy of nonbonded side chains
341 C assuming the LJ potential of interaction.
343 implicit real*8 (a-h,o-z)
345 include 'DIMENSIONS.ZSCOPT'
346 include "DIMENSIONS.COMPAR"
347 parameter (accur=1.0d-10)
350 include 'COMMON.LOCAL'
351 include 'COMMON.CHAIN'
352 include 'COMMON.DERIV'
353 include 'COMMON.INTERACT'
354 include 'COMMON.TORSION'
355 include 'COMMON.ENEPS'
356 include 'COMMON.SBRIDGE'
357 include 'COMMON.NAMES'
358 include 'COMMON.IOUNITS'
359 include 'COMMON.CONTACTS'
363 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
366 eneps_temp(j,i)=0.0d0
380 C Calculate SC interaction energy.
383 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
384 cd & 'iend=',iend(i,iint)
385 do j=istart(i,iint),iend(i,iint)
390 C Change 12/1/95 to calculate four-body interactions
391 rij=xj*xj+yj*yj+zj*zj
393 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
394 eps0ij=eps(itypi,itypj)
396 e1=fac*fac*aa(itypi,itypj)
397 e2=fac*bb(itypi,itypj)
399 ij=icant(itypi,itypj)
400 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
401 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
402 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
403 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
404 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
405 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
406 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
407 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
408 if (bb(itypi,itypj).gt.0.0d0) then
415 C Calculate the components of the gradient in DC and X
417 fac=-rrij*(e1+evdwij)
422 gvdwx(k,i)=gvdwx(k,i)-gg(k)
423 gvdwx(k,j)=gvdwx(k,j)+gg(k)
427 gvdwc(l,k)=gvdwc(l,k)+gg(l)
432 C 12/1/95, revised on 5/20/97
434 C Calculate the contact function. The ith column of the array JCONT will
435 C contain the numbers of atoms that make contacts with the atom I (of numbers
436 C greater than I). The arrays FACONT and GACONT will contain the values of
437 C the contact function and its derivative.
439 C Uncomment next line, if the correlation interactions include EVDW explicitly.
440 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
441 C Uncomment next line, if the correlation interactions are contact function only
442 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
444 sigij=sigma(itypi,itypj)
445 r0ij=rs0(itypi,itypj)
447 C Check whether the SC's are not too far to make a contact.
450 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
451 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
453 if (fcont.gt.0.0D0) then
454 C If the SC-SC distance if close to sigma, apply spline.
455 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
456 cAdam & fcont1,fprimcont1)
457 cAdam fcont1=1.0d0-fcont1
458 cAdam if (fcont1.gt.0.0d0) then
459 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
460 cAdam fcont=fcont*fcont1
462 C Uncomment following 4 lines to have the geometric average of the epsilon0's
463 cga eps0ij=1.0d0/dsqrt(eps0ij)
465 cga gg(k)=gg(k)*eps0ij
467 cga eps0ij=-evdwij*eps0ij
468 C Uncomment for AL's type of SC correlation interactions.
470 num_conti=num_conti+1
472 facont(num_conti,i)=fcont*eps0ij
473 fprimcont=eps0ij*fprimcont/rij
475 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
476 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
477 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
478 C Uncomment following 3 lines for Skolnick's type of SC correlation.
479 gacont(1,num_conti,i)=-fprimcont*xj
480 gacont(2,num_conti,i)=-fprimcont*yj
481 gacont(3,num_conti,i)=-fprimcont*zj
482 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
483 cd write (iout,'(2i3,3f10.5)')
484 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
490 num_cont(i)=num_conti
495 gvdwc(j,i)=expon*gvdwc(j,i)
496 gvdwx(j,i)=expon*gvdwx(j,i)
500 C******************************************************************************
504 C To save time, the factor of EXPON has been extracted from ALL components
505 C of GVDWC and GRADX. Remember to multiply them by this factor before further
508 C******************************************************************************
511 C-----------------------------------------------------------------------------
512 subroutine eljk(evdw,evdw_t)
514 C This subroutine calculates the interaction energy of nonbonded side chains
515 C assuming the LJK potential of interaction.
517 implicit real*8 (a-h,o-z)
519 include 'DIMENSIONS.ZSCOPT'
520 include "DIMENSIONS.COMPAR"
523 include 'COMMON.LOCAL'
524 include 'COMMON.CHAIN'
525 include 'COMMON.DERIV'
526 include 'COMMON.INTERACT'
527 include 'COMMON.ENEPS'
528 include 'COMMON.IOUNITS'
529 include 'COMMON.NAMES'
534 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
537 eneps_temp(j,i)=0.0d0
549 C Calculate SC interaction energy.
552 do j=istart(i,iint),iend(i,iint)
557 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
559 e_augm=augm(itypi,itypj)*fac_augm
562 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
563 fac=r_shift_inv**expon
564 e1=fac*fac*aa(itypi,itypj)
565 e2=fac*bb(itypi,itypj)
567 ij=icant(itypi,itypj)
568 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
569 & /dabs(eps(itypi,itypj))
570 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
571 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
572 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
573 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
574 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
575 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
576 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
577 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
578 if (bb(itypi,itypj).gt.0.0d0) then
585 C Calculate the components of the gradient in DC and X
587 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
592 gvdwx(k,i)=gvdwx(k,i)-gg(k)
593 gvdwx(k,j)=gvdwx(k,j)+gg(k)
597 gvdwc(l,k)=gvdwc(l,k)+gg(l)
607 gvdwc(j,i)=expon*gvdwc(j,i)
608 gvdwx(j,i)=expon*gvdwx(j,i)
614 C-----------------------------------------------------------------------------
615 subroutine ebp(evdw,evdw_t)
617 C This subroutine calculates the interaction energy of nonbonded side chains
618 C assuming the Berne-Pechukas potential of interaction.
620 implicit real*8 (a-h,o-z)
622 include 'DIMENSIONS.ZSCOPT'
623 include "DIMENSIONS.COMPAR"
626 include 'COMMON.LOCAL'
627 include 'COMMON.CHAIN'
628 include 'COMMON.DERIV'
629 include 'COMMON.NAMES'
630 include 'COMMON.INTERACT'
631 include 'COMMON.ENEPS'
632 include 'COMMON.IOUNITS'
633 include 'COMMON.CALC'
635 c double precision rrsave(maxdim)
641 eneps_temp(j,i)=0.0d0
646 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
647 c if (icall.eq.0) then
659 dxi=dc_norm(1,nres+i)
660 dyi=dc_norm(2,nres+i)
661 dzi=dc_norm(3,nres+i)
662 dsci_inv=vbld_inv(i+nres)
664 C Calculate SC interaction energy.
667 do j=istart(i,iint),iend(i,iint)
670 dscj_inv=vbld_inv(j+nres)
671 chi1=chi(itypi,itypj)
672 chi2=chi(itypj,itypi)
679 alf12=0.5D0*(alf1+alf2)
680 C For diagnostics only!!!
693 dxj=dc_norm(1,nres+j)
694 dyj=dc_norm(2,nres+j)
695 dzj=dc_norm(3,nres+j)
696 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
697 cd if (icall.eq.0) then
703 C Calculate the angle-dependent terms of energy & contributions to derivatives.
705 C Calculate whole angle-dependent part of epsilon and contributions
707 fac=(rrij*sigsq)**expon2
708 e1=fac*fac*aa(itypi,itypj)
709 e2=fac*bb(itypi,itypj)
710 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
711 eps2der=evdwij*eps3rt
712 eps3der=evdwij*eps2rt
713 evdwij=evdwij*eps2rt*eps3rt
714 ij=icant(itypi,itypj)
715 aux=eps1*eps2rt**2*eps3rt**2
716 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
717 & /dabs(eps(itypi,itypj))
718 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
719 if (bb(itypi,itypj).gt.0.0d0) then
726 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
727 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
728 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
729 cd & restyp(itypi),i,restyp(itypj),j,
730 cd & epsi,sigm,chi1,chi2,chip1,chip2,
731 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
732 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
735 C Calculate gradient components.
736 e1=e1*eps1*eps2rt**2*eps3rt**2
737 fac=-expon*(e1+evdwij)
740 C Calculate radial part of the gradient
744 C Calculate the angular part of the gradient and sum add the contributions
745 C to the appropriate components of the Cartesian gradient.
754 C-----------------------------------------------------------------------------
755 subroutine egb(evdw,evdw_t)
757 C This subroutine calculates the interaction energy of nonbonded side chains
758 C assuming the Gay-Berne potential of interaction.
760 implicit real*8 (a-h,o-z)
762 include 'DIMENSIONS.ZSCOPT'
763 include "DIMENSIONS.COMPAR"
766 include 'COMMON.LOCAL'
767 include 'COMMON.CHAIN'
768 include 'COMMON.DERIV'
769 include 'COMMON.NAMES'
770 include 'COMMON.INTERACT'
771 include 'COMMON.ENEPS'
772 include 'COMMON.IOUNITS'
773 include 'COMMON.CALC'
774 include 'COMMON.SBRIDGE'
781 eneps_temp(j,i)=0.0d0
784 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
788 c if (icall.gt.0) lprn=.true.
796 dxi=dc_norm(1,nres+i)
797 dyi=dc_norm(2,nres+i)
798 dzi=dc_norm(3,nres+i)
799 dsci_inv=vbld_inv(i+nres)
801 C Calculate SC interaction energy.
804 do j=istart(i,iint),iend(i,iint)
805 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
806 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
807 call dyn_ssbond_ene(i,j,evdwij)
809 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
810 c & 'evdw',i,j,evdwij,' ss'
814 dscj_inv=vbld_inv(j+nres)
815 sig0ij=sigma(itypi,itypj)
816 chi1=chi(itypi,itypj)
817 chi2=chi(itypj,itypi)
824 alf12=0.5D0*(alf1+alf2)
825 C For diagnostics only!!!
838 dxj=dc_norm(1,nres+j)
839 dyj=dc_norm(2,nres+j)
840 dzj=dc_norm(3,nres+j)
841 c write (iout,*) i,j,xj,yj,zj
842 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
844 C Calculate angle-dependent terms of energy and contributions to their
848 sig=sig0ij*dsqrt(sigsq)
849 rij_shift=1.0D0/rij-sig+sig0ij
850 C I hate to put IF's in the loops, but here don't have another choice!!!!
851 if (rij_shift.le.0.0D0) then
856 c---------------------------------------------------------------
857 rij_shift=1.0D0/rij_shift
859 e1=fac*fac*aa(itypi,itypj)
860 e2=fac*bb(itypi,itypj)
861 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
862 eps2der=evdwij*eps3rt
863 eps3der=evdwij*eps2rt
864 evdwij=evdwij*eps2rt*eps3rt
865 if (bb(itypi,itypj).gt.0) then
870 ij=icant(itypi,itypj)
871 aux=eps1*eps2rt**2*eps3rt**2
872 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
873 & /dabs(eps(itypi,itypj))
874 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
875 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
876 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
877 c & aux*e2/eps(itypi,itypj)
878 c write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
880 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
881 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
882 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
883 & restyp(itypi),i,restyp(itypj),j,
884 & epsi,sigm,chi1,chi2,chip1,chip2,
885 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
886 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
890 C Calculate gradient components.
891 e1=e1*eps1*eps2rt**2*eps3rt**2
892 fac=-expon*(e1+evdwij)*rij_shift
895 C Calculate the radial part of the gradient
899 C Calculate angular part of the gradient.
908 C-----------------------------------------------------------------------------
909 subroutine egbv(evdw,evdw_t)
911 C This subroutine calculates the interaction energy of nonbonded side chains
912 C assuming the Gay-Berne-Vorobjev potential of interaction.
914 implicit real*8 (a-h,o-z)
916 include 'DIMENSIONS.ZSCOPT'
917 include "DIMENSIONS.COMPAR"
920 include 'COMMON.LOCAL'
921 include 'COMMON.CHAIN'
922 include 'COMMON.DERIV'
923 include 'COMMON.NAMES'
924 include 'COMMON.INTERACT'
925 include 'COMMON.ENEPS'
926 include 'COMMON.IOUNITS'
927 include 'COMMON.CALC'
934 eneps_temp(j,i)=0.0d0
939 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
942 c if (icall.gt.0) lprn=.true.
950 dxi=dc_norm(1,nres+i)
951 dyi=dc_norm(2,nres+i)
952 dzi=dc_norm(3,nres+i)
953 dsci_inv=vbld_inv(i+nres)
955 C Calculate SC interaction energy.
958 do j=istart(i,iint),iend(i,iint)
961 dscj_inv=vbld_inv(j+nres)
962 sig0ij=sigma(itypi,itypj)
964 chi1=chi(itypi,itypj)
965 chi2=chi(itypj,itypi)
972 alf12=0.5D0*(alf1+alf2)
973 C For diagnostics only!!!
986 dxj=dc_norm(1,nres+j)
987 dyj=dc_norm(2,nres+j)
988 dzj=dc_norm(3,nres+j)
989 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
991 C Calculate angle-dependent terms of energy and contributions to their
995 sig=sig0ij*dsqrt(sigsq)
996 rij_shift=1.0D0/rij-sig+r0ij
997 C I hate to put IF's in the loops, but here don't have another choice!!!!
998 if (rij_shift.le.0.0D0) then
1003 c---------------------------------------------------------------
1004 rij_shift=1.0D0/rij_shift
1005 fac=rij_shift**expon
1006 e1=fac*fac*aa(itypi,itypj)
1007 e2=fac*bb(itypi,itypj)
1008 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1009 eps2der=evdwij*eps3rt
1010 eps3der=evdwij*eps2rt
1011 fac_augm=rrij**expon
1012 e_augm=augm(itypi,itypj)*fac_augm
1013 evdwij=evdwij*eps2rt*eps3rt
1014 if (bb(itypi,itypj).gt.0.0d0) then
1015 evdw=evdw+evdwij+e_augm
1017 evdw_t=evdw_t+evdwij+e_augm
1019 ij=icant(itypi,itypj)
1020 aux=eps1*eps2rt**2*eps3rt**2
1021 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1022 & /dabs(eps(itypi,itypj))
1023 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1024 c eneps_temp(ij)=eneps_temp(ij)
1025 c & +(evdwij+e_augm)/eps(itypi,itypj)
1027 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1028 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1029 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1030 c & restyp(itypi),i,restyp(itypj),j,
1031 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1032 c & chi1,chi2,chip1,chip2,
1033 c & eps1,eps2rt**2,eps3rt**2,
1034 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1038 C Calculate gradient components.
1039 e1=e1*eps1*eps2rt**2*eps3rt**2
1040 fac=-expon*(e1+evdwij)*rij_shift
1042 fac=rij*fac-2*expon*rrij*e_augm
1043 C Calculate the radial part of the gradient
1047 C Calculate angular part of the gradient.
1055 C-----------------------------------------------------------------------------
1056 subroutine sc_angular
1057 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1058 C om12. Called by ebp, egb, and egbv.
1060 include 'COMMON.CALC'
1064 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1065 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1066 om12=dxi*dxj+dyi*dyj+dzi*dzj
1068 C Calculate eps1(om12) and its derivative in om12
1069 faceps1=1.0D0-om12*chiom12
1070 faceps1_inv=1.0D0/faceps1
1071 eps1=dsqrt(faceps1_inv)
1072 C Following variable is eps1*deps1/dom12
1073 eps1_om12=faceps1_inv*chiom12
1074 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1079 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1080 sigsq=1.0D0-facsig*faceps1_inv
1081 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1082 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1083 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1084 C Calculate eps2 and its derivatives in om1, om2, and om12.
1087 chipom12=chip12*om12
1088 facp=1.0D0-om12*chipom12
1090 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1091 C Following variable is the square root of eps2
1092 eps2rt=1.0D0-facp1*facp_inv
1093 C Following three variables are the derivatives of the square root of eps
1094 C in om1, om2, and om12.
1095 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1096 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1097 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1098 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1099 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1100 C Calculate whole angle-dependent part of epsilon and contributions
1101 C to its derivatives
1104 C----------------------------------------------------------------------------
1106 implicit real*8 (a-h,o-z)
1107 include 'DIMENSIONS'
1108 include 'DIMENSIONS.ZSCOPT'
1109 include 'COMMON.CHAIN'
1110 include 'COMMON.DERIV'
1111 include 'COMMON.CALC'
1112 double precision dcosom1(3),dcosom2(3)
1113 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1114 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1115 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1116 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1118 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1119 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1122 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1125 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1126 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1127 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1128 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1129 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1130 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1133 C Calculate the components of the gradient in DC and X
1137 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1142 c------------------------------------------------------------------------------
1143 subroutine vec_and_deriv
1144 implicit real*8 (a-h,o-z)
1145 include 'DIMENSIONS'
1146 include 'DIMENSIONS.ZSCOPT'
1147 include 'COMMON.IOUNITS'
1148 include 'COMMON.GEO'
1149 include 'COMMON.VAR'
1150 include 'COMMON.LOCAL'
1151 include 'COMMON.CHAIN'
1152 include 'COMMON.VECTORS'
1153 include 'COMMON.DERIV'
1154 include 'COMMON.INTERACT'
1155 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1156 C Compute the local reference systems. For reference system (i), the
1157 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1158 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1160 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1161 if (i.eq.nres-1) then
1162 C Case of the last full residue
1163 C Compute the Z-axis
1164 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1165 costh=dcos(pi-theta(nres))
1166 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1171 C Compute the derivatives of uz
1173 uzder(2,1,1)=-dc_norm(3,i-1)
1174 uzder(3,1,1)= dc_norm(2,i-1)
1175 uzder(1,2,1)= dc_norm(3,i-1)
1177 uzder(3,2,1)=-dc_norm(1,i-1)
1178 uzder(1,3,1)=-dc_norm(2,i-1)
1179 uzder(2,3,1)= dc_norm(1,i-1)
1182 uzder(2,1,2)= dc_norm(3,i)
1183 uzder(3,1,2)=-dc_norm(2,i)
1184 uzder(1,2,2)=-dc_norm(3,i)
1186 uzder(3,2,2)= dc_norm(1,i)
1187 uzder(1,3,2)= dc_norm(2,i)
1188 uzder(2,3,2)=-dc_norm(1,i)
1191 C Compute the Y-axis
1194 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1197 C Compute the derivatives of uy
1200 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1201 & -dc_norm(k,i)*dc_norm(j,i-1)
1202 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1204 uyder(j,j,1)=uyder(j,j,1)-costh
1205 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1210 uygrad(l,k,j,i)=uyder(l,k,j)
1211 uzgrad(l,k,j,i)=uzder(l,k,j)
1215 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1216 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1217 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1218 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1222 C Compute the Z-axis
1223 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1224 costh=dcos(pi-theta(i+2))
1225 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1230 C Compute the derivatives of uz
1232 uzder(2,1,1)=-dc_norm(3,i+1)
1233 uzder(3,1,1)= dc_norm(2,i+1)
1234 uzder(1,2,1)= dc_norm(3,i+1)
1236 uzder(3,2,1)=-dc_norm(1,i+1)
1237 uzder(1,3,1)=-dc_norm(2,i+1)
1238 uzder(2,3,1)= dc_norm(1,i+1)
1241 uzder(2,1,2)= dc_norm(3,i)
1242 uzder(3,1,2)=-dc_norm(2,i)
1243 uzder(1,2,2)=-dc_norm(3,i)
1245 uzder(3,2,2)= dc_norm(1,i)
1246 uzder(1,3,2)= dc_norm(2,i)
1247 uzder(2,3,2)=-dc_norm(1,i)
1250 C Compute the Y-axis
1253 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1256 C Compute the derivatives of uy
1259 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1260 & -dc_norm(k,i)*dc_norm(j,i+1)
1261 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1263 uyder(j,j,1)=uyder(j,j,1)-costh
1264 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1269 uygrad(l,k,j,i)=uyder(l,k,j)
1270 uzgrad(l,k,j,i)=uzder(l,k,j)
1274 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1275 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1276 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1277 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1283 vbld_inv_temp(1)=vbld_inv(i+1)
1284 if (i.lt.nres-1) then
1285 vbld_inv_temp(2)=vbld_inv(i+2)
1287 vbld_inv_temp(2)=vbld_inv(i)
1292 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1293 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1301 C-----------------------------------------------------------------------------
1302 subroutine vec_and_deriv_test
1303 implicit real*8 (a-h,o-z)
1304 include 'DIMENSIONS'
1305 include 'DIMENSIONS.ZSCOPT'
1306 include 'COMMON.IOUNITS'
1307 include 'COMMON.GEO'
1308 include 'COMMON.VAR'
1309 include 'COMMON.LOCAL'
1310 include 'COMMON.CHAIN'
1311 include 'COMMON.VECTORS'
1312 dimension uyder(3,3,2),uzder(3,3,2)
1313 C Compute the local reference systems. For reference system (i), the
1314 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1315 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1317 if (i.eq.nres-1) then
1318 C Case of the last full residue
1319 C Compute the Z-axis
1320 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1321 costh=dcos(pi-theta(nres))
1322 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1323 c write (iout,*) 'fac',fac,
1324 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1325 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1329 C Compute the derivatives of uz
1331 uzder(2,1,1)=-dc_norm(3,i-1)
1332 uzder(3,1,1)= dc_norm(2,i-1)
1333 uzder(1,2,1)= dc_norm(3,i-1)
1335 uzder(3,2,1)=-dc_norm(1,i-1)
1336 uzder(1,3,1)=-dc_norm(2,i-1)
1337 uzder(2,3,1)= dc_norm(1,i-1)
1340 uzder(2,1,2)= dc_norm(3,i)
1341 uzder(3,1,2)=-dc_norm(2,i)
1342 uzder(1,2,2)=-dc_norm(3,i)
1344 uzder(3,2,2)= dc_norm(1,i)
1345 uzder(1,3,2)= dc_norm(2,i)
1346 uzder(2,3,2)=-dc_norm(1,i)
1348 C Compute the Y-axis
1350 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1353 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1354 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1355 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1357 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1360 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1361 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1364 c write (iout,*) 'facy',facy,
1365 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1366 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1368 uy(k,i)=facy*uy(k,i)
1370 C Compute the derivatives of uy
1373 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1374 & -dc_norm(k,i)*dc_norm(j,i-1)
1375 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1377 c uyder(j,j,1)=uyder(j,j,1)-costh
1378 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1379 uyder(j,j,1)=uyder(j,j,1)
1380 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1381 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1387 uygrad(l,k,j,i)=uyder(l,k,j)
1388 uzgrad(l,k,j,i)=uzder(l,k,j)
1392 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1393 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1394 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1395 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1398 C Compute the Z-axis
1399 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1400 costh=dcos(pi-theta(i+2))
1401 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1402 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1406 C Compute the derivatives of uz
1408 uzder(2,1,1)=-dc_norm(3,i+1)
1409 uzder(3,1,1)= dc_norm(2,i+1)
1410 uzder(1,2,1)= dc_norm(3,i+1)
1412 uzder(3,2,1)=-dc_norm(1,i+1)
1413 uzder(1,3,1)=-dc_norm(2,i+1)
1414 uzder(2,3,1)= dc_norm(1,i+1)
1417 uzder(2,1,2)= dc_norm(3,i)
1418 uzder(3,1,2)=-dc_norm(2,i)
1419 uzder(1,2,2)=-dc_norm(3,i)
1421 uzder(3,2,2)= dc_norm(1,i)
1422 uzder(1,3,2)= dc_norm(2,i)
1423 uzder(2,3,2)=-dc_norm(1,i)
1425 C Compute the Y-axis
1427 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1428 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1429 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1431 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1434 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1435 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1438 c write (iout,*) 'facy',facy,
1439 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1440 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1442 uy(k,i)=facy*uy(k,i)
1444 C Compute the derivatives of uy
1447 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1448 & -dc_norm(k,i)*dc_norm(j,i+1)
1449 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1451 c uyder(j,j,1)=uyder(j,j,1)-costh
1452 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1453 uyder(j,j,1)=uyder(j,j,1)
1454 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1455 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1461 uygrad(l,k,j,i)=uyder(l,k,j)
1462 uzgrad(l,k,j,i)=uzder(l,k,j)
1466 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1467 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1468 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1469 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1476 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1477 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1484 C-----------------------------------------------------------------------------
1485 subroutine check_vecgrad
1486 implicit real*8 (a-h,o-z)
1487 include 'DIMENSIONS'
1488 include 'DIMENSIONS.ZSCOPT'
1489 include 'COMMON.IOUNITS'
1490 include 'COMMON.GEO'
1491 include 'COMMON.VAR'
1492 include 'COMMON.LOCAL'
1493 include 'COMMON.CHAIN'
1494 include 'COMMON.VECTORS'
1495 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1496 dimension uyt(3,maxres),uzt(3,maxres)
1497 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1498 double precision delta /1.0d-7/
1501 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1502 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1503 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1504 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1505 cd & (dc_norm(if90,i),if90=1,3)
1506 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1507 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1508 cd write(iout,'(a)')
1514 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1515 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1528 cd write (iout,*) 'i=',i
1530 erij(k)=dc_norm(k,i)
1534 dc_norm(k,i)=erij(k)
1536 dc_norm(j,i)=dc_norm(j,i)+delta
1537 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1539 c dc_norm(k,i)=dc_norm(k,i)/fac
1541 c write (iout,*) (dc_norm(k,i),k=1,3)
1542 c write (iout,*) (erij(k),k=1,3)
1545 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1546 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1547 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1548 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1550 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1551 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1552 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1555 dc_norm(k,i)=erij(k)
1558 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1559 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1560 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1561 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1562 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1563 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1564 cd write (iout,'(a)')
1569 C--------------------------------------------------------------------------
1570 subroutine set_matrices
1571 implicit real*8 (a-h,o-z)
1572 include 'DIMENSIONS'
1573 include 'DIMENSIONS.ZSCOPT'
1574 include 'COMMON.IOUNITS'
1575 include 'COMMON.GEO'
1576 include 'COMMON.VAR'
1577 include 'COMMON.LOCAL'
1578 include 'COMMON.CHAIN'
1579 include 'COMMON.DERIV'
1580 include 'COMMON.INTERACT'
1581 include 'COMMON.CONTACTS'
1582 include 'COMMON.TORSION'
1583 include 'COMMON.VECTORS'
1584 include 'COMMON.FFIELD'
1585 double precision auxvec(2),auxmat(2,2)
1587 C Compute the virtual-bond-torsional-angle dependent quantities needed
1588 C to calculate the el-loc multibody terms of various order.
1591 if (i .lt. nres+1) then
1628 if (i .gt. 3 .and. i .lt. nres+1) then
1629 obrot_der(1,i-2)=-sin1
1630 obrot_der(2,i-2)= cos1
1631 Ugder(1,1,i-2)= sin1
1632 Ugder(1,2,i-2)=-cos1
1633 Ugder(2,1,i-2)=-cos1
1634 Ugder(2,2,i-2)=-sin1
1637 obrot2_der(1,i-2)=-dwasin2
1638 obrot2_der(2,i-2)= dwacos2
1639 Ug2der(1,1,i-2)= dwasin2
1640 Ug2der(1,2,i-2)=-dwacos2
1641 Ug2der(2,1,i-2)=-dwacos2
1642 Ug2der(2,2,i-2)=-dwasin2
1644 obrot_der(1,i-2)=0.0d0
1645 obrot_der(2,i-2)=0.0d0
1646 Ugder(1,1,i-2)=0.0d0
1647 Ugder(1,2,i-2)=0.0d0
1648 Ugder(2,1,i-2)=0.0d0
1649 Ugder(2,2,i-2)=0.0d0
1650 obrot2_der(1,i-2)=0.0d0
1651 obrot2_der(2,i-2)=0.0d0
1652 Ug2der(1,1,i-2)=0.0d0
1653 Ug2der(1,2,i-2)=0.0d0
1654 Ug2der(2,1,i-2)=0.0d0
1655 Ug2der(2,2,i-2)=0.0d0
1657 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1658 iti = itortyp(itype(i-2))
1662 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1663 iti1 = itortyp(itype(i-1))
1667 cd write (iout,*) '*******i',i,' iti1',iti
1668 cd write (iout,*) 'b1',b1(:,iti)
1669 cd write (iout,*) 'b2',b2(:,iti)
1670 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1671 if (i .gt. iatel_s+2) then
1672 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1673 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1674 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1675 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1676 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1677 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1678 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1688 DtUg2(l,k,i-2)=0.0d0
1692 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1693 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1694 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1695 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1696 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1697 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1698 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1700 muder(k,i-2)=Ub2der(k,i-2)
1702 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1703 iti1 = itortyp(itype(i-1))
1708 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1710 C Vectors and matrices dependent on a single virtual-bond dihedral.
1711 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1712 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1713 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1714 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1715 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1716 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1717 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1718 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1719 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1720 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1721 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1723 C Matrices dependent on two consecutive virtual-bond dihedrals.
1724 C The order of matrices is from left to right.
1726 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1727 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1728 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1729 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1730 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1731 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1732 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1733 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1736 cd iti = itortyp(itype(i))
1739 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1740 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1745 C--------------------------------------------------------------------------
1746 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1748 C This subroutine calculates the average interaction energy and its gradient
1749 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1750 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1751 C The potential depends both on the distance of peptide-group centers and on
1752 C the orientation of the CA-CA virtual bonds.
1754 implicit real*8 (a-h,o-z)
1755 include 'DIMENSIONS'
1756 include 'DIMENSIONS.ZSCOPT'
1757 include 'COMMON.CONTROL'
1758 include 'COMMON.IOUNITS'
1759 include 'COMMON.GEO'
1760 include 'COMMON.VAR'
1761 include 'COMMON.LOCAL'
1762 include 'COMMON.CHAIN'
1763 include 'COMMON.DERIV'
1764 include 'COMMON.INTERACT'
1765 include 'COMMON.CONTACTS'
1766 include 'COMMON.TORSION'
1767 include 'COMMON.VECTORS'
1768 include 'COMMON.FFIELD'
1769 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1770 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1771 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1772 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1773 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1774 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1775 double precision scal_el /0.5d0/
1777 C 13-go grudnia roku pamietnego...
1778 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1779 & 0.0d0,1.0d0,0.0d0,
1780 & 0.0d0,0.0d0,1.0d0/
1781 cd write(iout,*) 'In EELEC'
1783 cd write(iout,*) 'Type',i
1784 cd write(iout,*) 'B1',B1(:,i)
1785 cd write(iout,*) 'B2',B2(:,i)
1786 cd write(iout,*) 'CC',CC(:,:,i)
1787 cd write(iout,*) 'DD',DD(:,:,i)
1788 cd write(iout,*) 'EE',EE(:,:,i)
1790 cd call check_vecgrad
1792 if (icheckgrad.eq.1) then
1794 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1796 dc_norm(k,i)=dc(k,i)*fac
1798 c write (iout,*) 'i',i,' fac',fac
1801 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1802 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1803 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1804 cd if (wel_loc.gt.0.0d0) then
1805 if (icheckgrad.eq.1) then
1806 call vec_and_deriv_test
1813 cd write (iout,*) 'i=',i
1815 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1818 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1819 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1832 cd print '(a)','Enter EELEC'
1833 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1835 gel_loc_loc(i)=0.0d0
1838 do i=iatel_s,iatel_e
1839 if (itel(i).eq.0) goto 1215
1843 dx_normi=dc_norm(1,i)
1844 dy_normi=dc_norm(2,i)
1845 dz_normi=dc_norm(3,i)
1846 xmedi=c(1,i)+0.5d0*dxi
1847 ymedi=c(2,i)+0.5d0*dyi
1848 zmedi=c(3,i)+0.5d0*dzi
1850 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1851 do j=ielstart(i),ielend(i)
1852 if (itel(j).eq.0) goto 1216
1856 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1857 aaa=app(iteli,itelj)
1858 bbb=bpp(iteli,itelj)
1859 C Diagnostics only!!!
1865 ael6i=ael6(iteli,itelj)
1866 ael3i=ael3(iteli,itelj)
1870 dx_normj=dc_norm(1,j)
1871 dy_normj=dc_norm(2,j)
1872 dz_normj=dc_norm(3,j)
1873 xj=c(1,j)+0.5D0*dxj-xmedi
1874 yj=c(2,j)+0.5D0*dyj-ymedi
1875 zj=c(3,j)+0.5D0*dzj-zmedi
1876 rij=xj*xj+yj*yj+zj*zj
1882 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1883 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1884 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1885 fac=cosa-3.0D0*cosb*cosg
1887 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1888 if (j.eq.i+2) ev1=scal_el*ev1
1893 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1896 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1897 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1898 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1901 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1902 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1903 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1904 cd & xmedi,ymedi,zmedi,xj,yj,zj
1906 C Calculate contributions to the Cartesian gradient.
1909 facvdw=-6*rrmij*(ev1+evdwij)
1910 facel=-3*rrmij*(el1+eesij)
1917 * Radial derivatives. First process both termini of the fragment (i,j)
1924 gelc(k,i)=gelc(k,i)+ghalf
1925 gelc(k,j)=gelc(k,j)+ghalf
1928 * Loop over residues i+1 thru j-1.
1932 gelc(l,k)=gelc(l,k)+ggg(l)
1940 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1941 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1944 * Loop over residues i+1 thru j-1.
1948 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1955 fac=-3*rrmij*(facvdw+facvdw+facel)
1961 * Radial derivatives. First process both termini of the fragment (i,j)
1968 gelc(k,i)=gelc(k,i)+ghalf
1969 gelc(k,j)=gelc(k,j)+ghalf
1972 * Loop over residues i+1 thru j-1.
1976 gelc(l,k)=gelc(l,k)+ggg(l)
1983 ecosa=2.0D0*fac3*fac1+fac4
1986 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1987 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1989 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1990 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1992 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1993 cd & (dcosg(k),k=1,3)
1995 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1999 gelc(k,i)=gelc(k,i)+ghalf
2000 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2001 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2002 gelc(k,j)=gelc(k,j)+ghalf
2003 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2004 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2008 gelc(l,k)=gelc(l,k)+ggg(l)
2013 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2014 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2015 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2017 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2018 C energy of a peptide unit is assumed in the form of a second-order
2019 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2020 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2021 C are computed for EVERY pair of non-contiguous peptide groups.
2023 if (j.lt.nres-1) then
2034 muij(kkk)=mu(k,i)*mu(l,j)
2037 cd write (iout,*) 'EELEC: i',i,' j',j
2038 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2039 cd write(iout,*) 'muij',muij
2040 ury=scalar(uy(1,i),erij)
2041 urz=scalar(uz(1,i),erij)
2042 vry=scalar(uy(1,j),erij)
2043 vrz=scalar(uz(1,j),erij)
2044 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2045 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2046 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2047 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2048 C For diagnostics only
2053 fac=dsqrt(-ael6i)*r3ij
2054 cd write (2,*) 'fac=',fac
2055 C For diagnostics only
2061 cd write (iout,'(4i5,4f10.5)')
2062 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2063 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2064 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2065 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2066 cd write (iout,'(4f10.5)')
2067 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2068 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2069 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2070 cd write (iout,'(2i3,9f10.5/)') i,j,
2071 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2073 C Derivatives of the elements of A in virtual-bond vectors
2074 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2081 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2082 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2083 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2084 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2085 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2086 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2087 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2088 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2089 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2090 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2091 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2092 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2102 C Compute radial contributions to the gradient
2124 C Add the contributions coming from er
2127 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2128 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2129 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2130 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2133 C Derivatives in DC(i)
2134 ghalf1=0.5d0*agg(k,1)
2135 ghalf2=0.5d0*agg(k,2)
2136 ghalf3=0.5d0*agg(k,3)
2137 ghalf4=0.5d0*agg(k,4)
2138 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2139 & -3.0d0*uryg(k,2)*vry)+ghalf1
2140 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2141 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2142 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2143 & -3.0d0*urzg(k,2)*vry)+ghalf3
2144 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2145 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2146 C Derivatives in DC(i+1)
2147 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2148 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2149 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2150 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2151 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2152 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2153 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2154 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2155 C Derivatives in DC(j)
2156 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2157 & -3.0d0*vryg(k,2)*ury)+ghalf1
2158 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2159 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2160 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2161 & -3.0d0*vryg(k,2)*urz)+ghalf3
2162 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2163 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2164 C Derivatives in DC(j+1) or DC(nres-1)
2165 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2166 & -3.0d0*vryg(k,3)*ury)
2167 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2168 & -3.0d0*vrzg(k,3)*ury)
2169 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2170 & -3.0d0*vryg(k,3)*urz)
2171 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2172 & -3.0d0*vrzg(k,3)*urz)
2177 C Derivatives in DC(i+1)
2178 cd aggi1(k,1)=agg(k,1)
2179 cd aggi1(k,2)=agg(k,2)
2180 cd aggi1(k,3)=agg(k,3)
2181 cd aggi1(k,4)=agg(k,4)
2182 C Derivatives in DC(j)
2187 C Derivatives in DC(j+1)
2192 if (j.eq.nres-1 .and. i.lt.j-2) then
2194 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2195 cd aggj1(k,l)=agg(k,l)
2201 C Check the loc-el terms by numerical integration
2211 aggi(k,l)=-aggi(k,l)
2212 aggi1(k,l)=-aggi1(k,l)
2213 aggj(k,l)=-aggj(k,l)
2214 aggj1(k,l)=-aggj1(k,l)
2217 if (j.lt.nres-1) then
2223 aggi(k,l)=-aggi(k,l)
2224 aggi1(k,l)=-aggi1(k,l)
2225 aggj(k,l)=-aggj(k,l)
2226 aggj1(k,l)=-aggj1(k,l)
2237 aggi(k,l)=-aggi(k,l)
2238 aggi1(k,l)=-aggi1(k,l)
2239 aggj(k,l)=-aggj(k,l)
2240 aggj1(k,l)=-aggj1(k,l)
2246 IF (wel_loc.gt.0.0d0) THEN
2247 C Contribution to the local-electrostatic energy coming from the i-j pair
2248 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2250 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2251 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2252 eel_loc=eel_loc+eel_loc_ij
2253 C Partial derivatives in virtual-bond dihedral angles gamma
2256 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2257 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2258 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2259 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2260 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2261 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2262 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2263 cd write(iout,*) 'agg ',agg
2264 cd write(iout,*) 'aggi ',aggi
2265 cd write(iout,*) 'aggi1',aggi1
2266 cd write(iout,*) 'aggj ',aggj
2267 cd write(iout,*) 'aggj1',aggj1
2269 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2271 ggg(l)=agg(l,1)*muij(1)+
2272 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2276 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2279 C Remaining derivatives of eello
2281 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2282 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2283 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2284 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2285 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2286 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2287 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2288 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2292 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2293 C Contributions from turns
2298 call eturn34(i,j,eello_turn3,eello_turn4)
2300 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2301 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2303 C Calculate the contact function. The ith column of the array JCONT will
2304 C contain the numbers of atoms that make contacts with the atom I (of numbers
2305 C greater than I). The arrays FACONT and GACONT will contain the values of
2306 C the contact function and its derivative.
2307 c r0ij=1.02D0*rpp(iteli,itelj)
2308 c r0ij=1.11D0*rpp(iteli,itelj)
2309 r0ij=2.20D0*rpp(iteli,itelj)
2310 c r0ij=1.55D0*rpp(iteli,itelj)
2311 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2312 if (fcont.gt.0.0D0) then
2313 num_conti=num_conti+1
2314 if (num_conti.gt.maxconts) then
2315 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2316 & ' will skip next contacts for this conf.'
2318 jcont_hb(num_conti,i)=j
2319 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2320 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2321 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2323 d_cont(num_conti,i)=rij
2324 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2325 C --- Electrostatic-interaction matrix ---
2326 a_chuj(1,1,num_conti,i)=a22
2327 a_chuj(1,2,num_conti,i)=a23
2328 a_chuj(2,1,num_conti,i)=a32
2329 a_chuj(2,2,num_conti,i)=a33
2330 C --- Gradient of rij
2332 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2335 c a_chuj(1,1,num_conti,i)=-0.61d0
2336 c a_chuj(1,2,num_conti,i)= 0.4d0
2337 c a_chuj(2,1,num_conti,i)= 0.65d0
2338 c a_chuj(2,2,num_conti,i)= 0.50d0
2339 c else if (i.eq.2) then
2340 c a_chuj(1,1,num_conti,i)= 0.0d0
2341 c a_chuj(1,2,num_conti,i)= 0.0d0
2342 c a_chuj(2,1,num_conti,i)= 0.0d0
2343 c a_chuj(2,2,num_conti,i)= 0.0d0
2345 C --- and its gradients
2346 cd write (iout,*) 'i',i,' j',j
2348 cd write (iout,*) 'iii 1 kkk',kkk
2349 cd write (iout,*) agg(kkk,:)
2352 cd write (iout,*) 'iii 2 kkk',kkk
2353 cd write (iout,*) aggi(kkk,:)
2356 cd write (iout,*) 'iii 3 kkk',kkk
2357 cd write (iout,*) aggi1(kkk,:)
2360 cd write (iout,*) 'iii 4 kkk',kkk
2361 cd write (iout,*) aggj(kkk,:)
2364 cd write (iout,*) 'iii 5 kkk',kkk
2365 cd write (iout,*) aggj1(kkk,:)
2372 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2373 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2374 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2375 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2376 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2378 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2384 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2385 C Calculate contact energies
2387 wij=cosa-3.0D0*cosb*cosg
2390 c fac3=dsqrt(-ael6i)/r0ij**3
2391 fac3=dsqrt(-ael6i)*r3ij
2392 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2393 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2395 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2396 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2397 C Diagnostics. Comment out or remove after debugging!
2398 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2399 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2400 c ees0m(num_conti,i)=0.0D0
2402 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2403 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2404 facont_hb(num_conti,i)=fcont
2406 C Angular derivatives of the contact function
2407 ees0pij1=fac3/ees0pij
2408 ees0mij1=fac3/ees0mij
2409 fac3p=-3.0D0*fac3*rrmij
2410 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2411 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2413 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2414 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2415 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2416 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2417 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2418 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2419 ecosap=ecosa1+ecosa2
2420 ecosbp=ecosb1+ecosb2
2421 ecosgp=ecosg1+ecosg2
2422 ecosam=ecosa1-ecosa2
2423 ecosbm=ecosb1-ecosb2
2424 ecosgm=ecosg1-ecosg2
2433 fprimcont=fprimcont/rij
2434 cd facont_hb(num_conti,i)=1.0D0
2435 C Following line is for diagnostics.
2438 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2439 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2442 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2443 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2445 gggp(1)=gggp(1)+ees0pijp*xj
2446 gggp(2)=gggp(2)+ees0pijp*yj
2447 gggp(3)=gggp(3)+ees0pijp*zj
2448 gggm(1)=gggm(1)+ees0mijp*xj
2449 gggm(2)=gggm(2)+ees0mijp*yj
2450 gggm(3)=gggm(3)+ees0mijp*zj
2451 C Derivatives due to the contact function
2452 gacont_hbr(1,num_conti,i)=fprimcont*xj
2453 gacont_hbr(2,num_conti,i)=fprimcont*yj
2454 gacont_hbr(3,num_conti,i)=fprimcont*zj
2456 ghalfp=0.5D0*gggp(k)
2457 ghalfm=0.5D0*gggm(k)
2458 gacontp_hb1(k,num_conti,i)=ghalfp
2459 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2460 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2461 gacontp_hb2(k,num_conti,i)=ghalfp
2462 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2463 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2464 gacontp_hb3(k,num_conti,i)=gggp(k)
2465 gacontm_hb1(k,num_conti,i)=ghalfm
2466 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2467 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2468 gacontm_hb2(k,num_conti,i)=ghalfm
2469 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2470 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2471 gacontm_hb3(k,num_conti,i)=gggm(k)
2474 C Diagnostics. Comment out or remove after debugging!
2476 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2477 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2478 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2479 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2480 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2481 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2484 endif ! num_conti.le.maxconts
2489 num_cont_hb(i)=num_conti
2493 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2494 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2496 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2497 ccc eel_loc=eel_loc+eello_turn3
2500 C-----------------------------------------------------------------------------
2501 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2502 C Third- and fourth-order contributions from turns
2503 implicit real*8 (a-h,o-z)
2504 include 'DIMENSIONS'
2505 include 'DIMENSIONS.ZSCOPT'
2506 include 'COMMON.IOUNITS'
2507 include 'COMMON.GEO'
2508 include 'COMMON.VAR'
2509 include 'COMMON.LOCAL'
2510 include 'COMMON.CHAIN'
2511 include 'COMMON.DERIV'
2512 include 'COMMON.INTERACT'
2513 include 'COMMON.CONTACTS'
2514 include 'COMMON.TORSION'
2515 include 'COMMON.VECTORS'
2516 include 'COMMON.FFIELD'
2518 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2519 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2520 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2521 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2522 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2523 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2525 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2527 C Third-order contributions
2534 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2535 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2536 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2537 call transpose2(auxmat(1,1),auxmat1(1,1))
2538 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2539 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2540 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2541 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2542 cd & ' eello_turn3_num',4*eello_turn3_num
2544 C Derivatives in gamma(i)
2545 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2546 call transpose2(auxmat2(1,1),pizda(1,1))
2547 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2548 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2549 C Derivatives in gamma(i+1)
2550 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2551 call transpose2(auxmat2(1,1),pizda(1,1))
2552 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2553 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2554 & +0.5d0*(pizda(1,1)+pizda(2,2))
2555 C Cartesian derivatives
2557 a_temp(1,1)=aggi(l,1)
2558 a_temp(1,2)=aggi(l,2)
2559 a_temp(2,1)=aggi(l,3)
2560 a_temp(2,2)=aggi(l,4)
2561 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2562 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2563 & +0.5d0*(pizda(1,1)+pizda(2,2))
2564 a_temp(1,1)=aggi1(l,1)
2565 a_temp(1,2)=aggi1(l,2)
2566 a_temp(2,1)=aggi1(l,3)
2567 a_temp(2,2)=aggi1(l,4)
2568 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2569 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2570 & +0.5d0*(pizda(1,1)+pizda(2,2))
2571 a_temp(1,1)=aggj(l,1)
2572 a_temp(1,2)=aggj(l,2)
2573 a_temp(2,1)=aggj(l,3)
2574 a_temp(2,2)=aggj(l,4)
2575 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2576 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2577 & +0.5d0*(pizda(1,1)+pizda(2,2))
2578 a_temp(1,1)=aggj1(l,1)
2579 a_temp(1,2)=aggj1(l,2)
2580 a_temp(2,1)=aggj1(l,3)
2581 a_temp(2,2)=aggj1(l,4)
2582 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2583 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2584 & +0.5d0*(pizda(1,1)+pizda(2,2))
2587 else if (j.eq.i+3) then
2588 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2590 C Fourth-order contributions
2598 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2599 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2600 iti1=itortyp(itype(i+1))
2601 iti2=itortyp(itype(i+2))
2602 iti3=itortyp(itype(i+3))
2603 call transpose2(EUg(1,1,i+1),e1t(1,1))
2604 call transpose2(Eug(1,1,i+2),e2t(1,1))
2605 call transpose2(Eug(1,1,i+3),e3t(1,1))
2606 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2607 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2608 s1=scalar2(b1(1,iti2),auxvec(1))
2609 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2610 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2611 s2=scalar2(b1(1,iti1),auxvec(1))
2612 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2613 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2614 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2615 eello_turn4=eello_turn4-(s1+s2+s3)
2616 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2617 cd & ' eello_turn4_num',8*eello_turn4_num
2618 C Derivatives in gamma(i)
2620 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2621 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2622 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2623 s1=scalar2(b1(1,iti2),auxvec(1))
2624 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2625 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2626 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2627 C Derivatives in gamma(i+1)
2628 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2629 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2630 s2=scalar2(b1(1,iti1),auxvec(1))
2631 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2632 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2633 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2634 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2635 C Derivatives in gamma(i+2)
2636 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2637 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2638 s1=scalar2(b1(1,iti2),auxvec(1))
2639 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2640 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2641 s2=scalar2(b1(1,iti1),auxvec(1))
2642 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2643 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2644 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2645 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2646 C Cartesian derivatives
2647 C Derivatives of this turn contributions in DC(i+2)
2648 if (j.lt.nres-1) then
2650 a_temp(1,1)=agg(l,1)
2651 a_temp(1,2)=agg(l,2)
2652 a_temp(2,1)=agg(l,3)
2653 a_temp(2,2)=agg(l,4)
2654 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2655 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2656 s1=scalar2(b1(1,iti2),auxvec(1))
2657 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2658 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2659 s2=scalar2(b1(1,iti1),auxvec(1))
2660 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2661 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2662 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2664 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2667 C Remaining derivatives of this turn contribution
2669 a_temp(1,1)=aggi(l,1)
2670 a_temp(1,2)=aggi(l,2)
2671 a_temp(2,1)=aggi(l,3)
2672 a_temp(2,2)=aggi(l,4)
2673 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2674 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2675 s1=scalar2(b1(1,iti2),auxvec(1))
2676 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2677 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2678 s2=scalar2(b1(1,iti1),auxvec(1))
2679 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2680 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2681 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2682 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2683 a_temp(1,1)=aggi1(l,1)
2684 a_temp(1,2)=aggi1(l,2)
2685 a_temp(2,1)=aggi1(l,3)
2686 a_temp(2,2)=aggi1(l,4)
2687 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2688 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2689 s1=scalar2(b1(1,iti2),auxvec(1))
2690 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2691 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2692 s2=scalar2(b1(1,iti1),auxvec(1))
2693 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2694 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2695 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2696 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2697 a_temp(1,1)=aggj(l,1)
2698 a_temp(1,2)=aggj(l,2)
2699 a_temp(2,1)=aggj(l,3)
2700 a_temp(2,2)=aggj(l,4)
2701 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2702 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2703 s1=scalar2(b1(1,iti2),auxvec(1))
2704 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2705 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2706 s2=scalar2(b1(1,iti1),auxvec(1))
2707 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2708 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2709 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2710 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2711 a_temp(1,1)=aggj1(l,1)
2712 a_temp(1,2)=aggj1(l,2)
2713 a_temp(2,1)=aggj1(l,3)
2714 a_temp(2,2)=aggj1(l,4)
2715 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2716 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2717 s1=scalar2(b1(1,iti2),auxvec(1))
2718 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2719 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2720 s2=scalar2(b1(1,iti1),auxvec(1))
2721 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2722 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2723 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2724 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2730 C-----------------------------------------------------------------------------
2731 subroutine vecpr(u,v,w)
2732 implicit real*8(a-h,o-z)
2733 dimension u(3),v(3),w(3)
2734 w(1)=u(2)*v(3)-u(3)*v(2)
2735 w(2)=-u(1)*v(3)+u(3)*v(1)
2736 w(3)=u(1)*v(2)-u(2)*v(1)
2739 C-----------------------------------------------------------------------------
2740 subroutine unormderiv(u,ugrad,unorm,ungrad)
2741 C This subroutine computes the derivatives of a normalized vector u, given
2742 C the derivatives computed without normalization conditions, ugrad. Returns
2745 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2746 double precision vec(3)
2747 double precision scalar
2749 c write (2,*) 'ugrad',ugrad
2752 vec(i)=scalar(ugrad(1,i),u(1))
2754 c write (2,*) 'vec',vec
2757 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2760 c write (2,*) 'ungrad',ungrad
2763 C-----------------------------------------------------------------------------
2764 subroutine escp(evdw2,evdw2_14)
2766 C This subroutine calculates the excluded-volume interaction energy between
2767 C peptide-group centers and side chains and its gradient in virtual-bond and
2768 C side-chain vectors.
2770 implicit real*8 (a-h,o-z)
2771 include 'DIMENSIONS'
2772 include 'DIMENSIONS.ZSCOPT'
2773 include 'COMMON.GEO'
2774 include 'COMMON.VAR'
2775 include 'COMMON.LOCAL'
2776 include 'COMMON.CHAIN'
2777 include 'COMMON.DERIV'
2778 include 'COMMON.INTERACT'
2779 include 'COMMON.FFIELD'
2780 include 'COMMON.IOUNITS'
2784 cd print '(a)','Enter ESCP'
2785 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2786 c & ' scal14',scal14
2787 do i=iatscp_s,iatscp_e
2789 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2790 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2791 if (iteli.eq.0) goto 1225
2792 xi=0.5D0*(c(1,i)+c(1,i+1))
2793 yi=0.5D0*(c(2,i)+c(2,i+1))
2794 zi=0.5D0*(c(3,i)+c(3,i+1))
2796 do iint=1,nscp_gr(i)
2798 do j=iscpstart(i,iint),iscpend(i,iint)
2800 C Uncomment following three lines for SC-p interactions
2804 C Uncomment following three lines for Ca-p interactions
2808 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2810 e1=fac*fac*aad(itypj,iteli)
2811 e2=fac*bad(itypj,iteli)
2812 if (iabs(j-i) .le. 2) then
2815 evdw2_14=evdw2_14+e1+e2
2818 c write (iout,*) i,j,evdwij
2822 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2824 fac=-(evdwij+e1)*rrij
2829 cd write (iout,*) 'j<i'
2830 C Uncomment following three lines for SC-p interactions
2832 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2835 cd write (iout,*) 'j>i'
2838 C Uncomment following line for SC-p interactions
2839 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2843 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2847 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2848 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2851 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2861 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2862 gradx_scp(j,i)=expon*gradx_scp(j,i)
2865 C******************************************************************************
2869 C To save time the factor EXPON has been extracted from ALL components
2870 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2873 C******************************************************************************
2876 C--------------------------------------------------------------------------
2877 subroutine edis(ehpb)
2879 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2881 implicit real*8 (a-h,o-z)
2882 include 'DIMENSIONS'
2883 include 'COMMON.SBRIDGE'
2884 include 'COMMON.CHAIN'
2885 include 'COMMON.DERIV'
2886 include 'COMMON.VAR'
2887 include 'COMMON.INTERACT'
2888 include 'COMMON.IOUNITS'
2891 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2892 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2893 if (link_end.eq.0) return
2894 do i=link_start,link_end
2895 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2896 C CA-CA distance used in regularization of structure.
2899 C iii and jjj point to the residues for which the distance is assigned.
2900 if (ii.gt.nres) then
2907 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2908 c & dhpb(i),dhpb1(i),forcon(i)
2909 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2910 C distance and angle dependent SS bond potential.
2911 if (.not.dyn_ss .and. i.le.nss) then
2912 C 15/02/13 CC dynamic SSbond - additional check
2913 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2914 call ssbond_ene(iii,jjj,eij)
2917 cd write (iout,*) "eij",eij
2918 else if (ii.gt.nres .and. jj.gt.nres) then
2919 c Restraints from contact prediction
2921 if (dhpb1(i).gt.0.0d0) then
2922 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2923 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2924 c write (iout,*) "beta nmr",
2925 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2929 C Get the force constant corresponding to this distance.
2931 C Calculate the contribution to energy.
2932 ehpb=ehpb+waga*rdis*rdis
2933 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2935 C Evaluate gradient.
2940 ggg(j)=fac*(c(j,jj)-c(j,ii))
2943 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2944 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2947 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2948 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2951 C Calculate the distance between the two points and its difference from the
2954 if (dhpb1(i).gt.0.0d0) then
2955 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2956 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2957 c write (iout,*) "alph nmr",
2958 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2961 C Get the force constant corresponding to this distance.
2963 C Calculate the contribution to energy.
2964 ehpb=ehpb+waga*rdis*rdis
2965 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2967 C Evaluate gradient.
2971 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2972 cd & ' waga=',waga,' fac=',fac
2974 ggg(j)=fac*(c(j,jj)-c(j,ii))
2976 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2977 C If this is a SC-SC distance, we need to calculate the contributions to the
2978 C Cartesian gradient in the SC vectors (ghpbx).
2981 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2982 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2986 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2987 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2994 C--------------------------------------------------------------------------
2995 subroutine ssbond_ene(i,j,eij)
2997 C Calculate the distance and angle dependent SS-bond potential energy
2998 C using a free-energy function derived based on RHF/6-31G** ab initio
2999 C calculations of diethyl disulfide.
3001 C A. Liwo and U. Kozlowska, 11/24/03
3003 implicit real*8 (a-h,o-z)
3004 include 'DIMENSIONS'
3005 include 'DIMENSIONS.ZSCOPT'
3006 include 'COMMON.SBRIDGE'
3007 include 'COMMON.CHAIN'
3008 include 'COMMON.DERIV'
3009 include 'COMMON.LOCAL'
3010 include 'COMMON.INTERACT'
3011 include 'COMMON.VAR'
3012 include 'COMMON.IOUNITS'
3013 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3018 dxi=dc_norm(1,nres+i)
3019 dyi=dc_norm(2,nres+i)
3020 dzi=dc_norm(3,nres+i)
3021 dsci_inv=dsc_inv(itypi)
3023 dscj_inv=dsc_inv(itypj)
3027 dxj=dc_norm(1,nres+j)
3028 dyj=dc_norm(2,nres+j)
3029 dzj=dc_norm(3,nres+j)
3030 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3035 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3036 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3037 om12=dxi*dxj+dyi*dyj+dzi*dzj
3039 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3040 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3046 deltat12=om2-om1+2.0d0
3048 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3049 & +akct*deltad*deltat12+ebr
3050 c & +akct*deltad*deltat12
3051 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3052 write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3053 & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3054 & " deltat12",deltat12," eij",eij,"ebr",ebr
3055 ed=2*akcm*deltad+akct*deltat12
3057 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3058 eom1=-2*akth*deltat1-pom1-om2*pom2
3059 eom2= 2*akth*deltat2+pom1-om1*pom2
3062 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3065 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3066 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3067 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3068 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3071 C Calculate the components of the gradient in DC and X
3075 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3080 C--------------------------------------------------------------------------
3081 subroutine ebond(estr)
3083 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3085 implicit real*8 (a-h,o-z)
3086 include 'DIMENSIONS'
3087 include 'DIMENSIONS.ZSCOPT'
3088 include 'COMMON.LOCAL'
3089 include 'COMMON.GEO'
3090 include 'COMMON.INTERACT'
3091 include 'COMMON.DERIV'
3092 include 'COMMON.VAR'
3093 include 'COMMON.CHAIN'
3094 include 'COMMON.IOUNITS'
3095 include 'COMMON.NAMES'
3096 include 'COMMON.FFIELD'
3097 include 'COMMON.CONTROL'
3098 double precision u(3),ud(3)
3102 diff = vbld(i)-vbldp0
3103 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3106 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3111 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3118 diff=vbld(i+nres)-vbldsc0(1,iti)
3120 & write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3121 & AKSC(1,iti),AKSC(1,iti)*diff*diff
3122 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3124 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3128 diff=vbld(i+nres)-vbldsc0(j,iti)
3129 ud(j)=aksc(j,iti)*diff
3130 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3144 uprod2=uprod2*u(k)*u(k)
3148 usumsqder=usumsqder+ud(j)*uprod2
3151 & write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3152 & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3153 estr=estr+uprod/usum
3155 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3163 C--------------------------------------------------------------------------
3164 subroutine ebend(etheta)
3166 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3167 C angles gamma and its derivatives in consecutive thetas and gammas.
3169 implicit real*8 (a-h,o-z)
3170 include 'DIMENSIONS'
3171 include 'DIMENSIONS.ZSCOPT'
3172 include 'COMMON.LOCAL'
3173 include 'COMMON.GEO'
3174 include 'COMMON.INTERACT'
3175 include 'COMMON.DERIV'
3176 include 'COMMON.VAR'
3177 include 'COMMON.CHAIN'
3178 include 'COMMON.IOUNITS'
3179 include 'COMMON.NAMES'
3180 include 'COMMON.FFIELD'
3181 common /calcthet/ term1,term2,termm,diffak,ratak,
3182 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3183 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3184 double precision y(2),z(2)
3186 time11=dexp(-2*time)
3189 c write (iout,*) "nres",nres
3190 c write (*,'(a,i2)') 'EBEND ICG=',icg
3191 c write (iout,*) ithet_start,ithet_end
3192 do i=ithet_start,ithet_end
3193 C Zero the energy function and its derivative at 0 or pi.
3194 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3196 c if (i.gt.ithet_start .and.
3197 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3198 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3206 c if (i.lt.nres .and. itel(i).ne.0) then
3218 call proc_proc(phii,icrc)
3219 if (icrc.eq.1) phii=150.0
3233 call proc_proc(phii1,icrc)
3234 if (icrc.eq.1) phii1=150.0
3246 C Calculate the "mean" value of theta from the part of the distribution
3247 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3248 C In following comments this theta will be referred to as t_c.
3249 thet_pred_mean=0.0d0
3253 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3255 c write (iout,*) "thet_pred_mean",thet_pred_mean
3256 dthett=thet_pred_mean*ssd
3257 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3258 c write (iout,*) "thet_pred_mean",thet_pred_mean
3259 C Derivatives of the "mean" values in gamma1 and gamma2.
3260 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3261 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3262 if (theta(i).gt.pi-delta) then
3263 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3265 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3266 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3267 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3269 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3271 else if (theta(i).lt.delta) then
3272 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3273 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3274 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3276 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3277 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3280 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3283 etheta=etheta+ethetai
3284 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3285 c & rad2deg*phii,rad2deg*phii1,ethetai
3286 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3287 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3288 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3291 C Ufff.... We've done all this!!!
3294 C---------------------------------------------------------------------------
3295 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3297 implicit real*8 (a-h,o-z)
3298 include 'DIMENSIONS'
3299 include 'COMMON.LOCAL'
3300 include 'COMMON.IOUNITS'
3301 common /calcthet/ term1,term2,termm,diffak,ratak,
3302 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3303 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3304 C Calculate the contributions to both Gaussian lobes.
3305 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3306 C The "polynomial part" of the "standard deviation" of this part of
3310 sig=sig*thet_pred_mean+polthet(j,it)
3312 C Derivative of the "interior part" of the "standard deviation of the"
3313 C gamma-dependent Gaussian lobe in t_c.
3314 sigtc=3*polthet(3,it)
3316 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3319 C Set the parameters of both Gaussian lobes of the distribution.
3320 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3321 fac=sig*sig+sigc0(it)
3324 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3325 sigsqtc=-4.0D0*sigcsq*sigtc
3326 c print *,i,sig,sigtc,sigsqtc
3327 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3328 sigtc=-sigtc/(fac*fac)
3329 C Following variable is sigma(t_c)**(-2)
3330 sigcsq=sigcsq*sigcsq
3332 sig0inv=1.0D0/sig0i**2
3333 delthec=thetai-thet_pred_mean
3334 delthe0=thetai-theta0i
3335 term1=-0.5D0*sigcsq*delthec*delthec
3336 term2=-0.5D0*sig0inv*delthe0*delthe0
3337 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3338 C NaNs in taking the logarithm. We extract the largest exponent which is added
3339 C to the energy (this being the log of the distribution) at the end of energy
3340 C term evaluation for this virtual-bond angle.
3341 if (term1.gt.term2) then
3343 term2=dexp(term2-termm)
3347 term1=dexp(term1-termm)
3350 C The ratio between the gamma-independent and gamma-dependent lobes of
3351 C the distribution is a Gaussian function of thet_pred_mean too.
3352 diffak=gthet(2,it)-thet_pred_mean
3353 ratak=diffak/gthet(3,it)**2
3354 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3355 C Let's differentiate it in thet_pred_mean NOW.
3357 C Now put together the distribution terms to make complete distribution.
3358 termexp=term1+ak*term2
3359 termpre=sigc+ak*sig0i
3360 C Contribution of the bending energy from this theta is just the -log of
3361 C the sum of the contributions from the two lobes and the pre-exponential
3362 C factor. Simple enough, isn't it?
3363 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3364 C NOW the derivatives!!!
3365 C 6/6/97 Take into account the deformation.
3366 E_theta=(delthec*sigcsq*term1
3367 & +ak*delthe0*sig0inv*term2)/termexp
3368 E_tc=((sigtc+aktc*sig0i)/termpre
3369 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3370 & aktc*term2)/termexp)
3373 c-----------------------------------------------------------------------------
3374 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3375 implicit real*8 (a-h,o-z)
3376 include 'DIMENSIONS'
3377 include 'COMMON.LOCAL'
3378 include 'COMMON.IOUNITS'
3379 common /calcthet/ term1,term2,termm,diffak,ratak,
3380 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3381 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3382 delthec=thetai-thet_pred_mean
3383 delthe0=thetai-theta0i
3384 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3385 t3 = thetai-thet_pred_mean
3389 t14 = t12+t6*sigsqtc
3391 t21 = thetai-theta0i
3397 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3398 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3399 & *(-t12*t9-ak*sig0inv*t27)
3403 C--------------------------------------------------------------------------
3404 subroutine ebend(etheta)
3406 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3407 C angles gamma and its derivatives in consecutive thetas and gammas.
3408 C ab initio-derived potentials from
3409 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3411 implicit real*8 (a-h,o-z)
3412 include 'DIMENSIONS'
3413 include 'DIMENSIONS.ZSCOPT'
3414 include 'COMMON.LOCAL'
3415 include 'COMMON.GEO'
3416 include 'COMMON.INTERACT'
3417 include 'COMMON.DERIV'
3418 include 'COMMON.VAR'
3419 include 'COMMON.CHAIN'
3420 include 'COMMON.IOUNITS'
3421 include 'COMMON.NAMES'
3422 include 'COMMON.FFIELD'
3423 include 'COMMON.CONTROL'
3424 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3425 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3426 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3427 & sinph1ph2(maxdouble,maxdouble)
3428 logical lprn /.false./, lprn1 /.false./
3430 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3431 do i=ithet_start,ithet_end
3435 theti2=0.5d0*theta(i)
3436 ityp2=ithetyp(itype(i-1))
3438 coskt(k)=dcos(k*theti2)
3439 sinkt(k)=dsin(k*theti2)
3444 if (phii.ne.phii) phii=150.0
3448 ityp1=ithetyp(itype(i-2))
3450 cosph1(k)=dcos(k*phii)
3451 sinph1(k)=dsin(k*phii)
3464 if (phii1.ne.phii1) phii1=150.0
3469 ityp3=ithetyp(itype(i))
3471 cosph2(k)=dcos(k*phii1)
3472 sinph2(k)=dsin(k*phii1)
3482 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3483 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3485 ethetai=aa0thet(ityp1,ityp2,ityp3)
3488 ccl=cosph1(l)*cosph2(k-l)
3489 ssl=sinph1(l)*sinph2(k-l)
3490 scl=sinph1(l)*cosph2(k-l)
3491 csl=cosph1(l)*sinph2(k-l)
3492 cosph1ph2(l,k)=ccl-ssl
3493 cosph1ph2(k,l)=ccl+ssl
3494 sinph1ph2(l,k)=scl+csl
3495 sinph1ph2(k,l)=scl-csl
3499 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3500 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3501 write (iout,*) "coskt and sinkt"
3503 write (iout,*) k,coskt(k),sinkt(k)
3507 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3508 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3511 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3512 & " ethetai",ethetai
3515 write (iout,*) "cosph and sinph"
3517 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3519 write (iout,*) "cosph1ph2 and sinph2ph2"
3522 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3523 & sinph1ph2(l,k),sinph1ph2(k,l)
3526 write(iout,*) "ethetai",ethetai
3530 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3531 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3532 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3533 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3534 ethetai=ethetai+sinkt(m)*aux
3535 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3536 dephii=dephii+k*sinkt(m)*(
3537 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3538 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3539 dephii1=dephii1+k*sinkt(m)*(
3540 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3541 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3543 & write (iout,*) "m",m," k",k," bbthet",
3544 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3545 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3546 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3547 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3551 & write(iout,*) "ethetai",ethetai
3555 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3556 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3557 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3558 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3559 ethetai=ethetai+sinkt(m)*aux
3560 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3561 dephii=dephii+l*sinkt(m)*(
3562 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3563 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3564 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3565 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3566 dephii1=dephii1+(k-l)*sinkt(m)*(
3567 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3568 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3569 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3570 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3572 write (iout,*) "m",m," k",k," l",l," ffthet",
3573 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3574 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3575 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3576 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3577 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3578 & cosph1ph2(k,l)*sinkt(m),
3579 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3585 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3586 & i,theta(i)*rad2deg,phii*rad2deg,
3587 & phii1*rad2deg,ethetai
3588 etheta=etheta+ethetai
3589 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3590 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3591 gloc(nphi+i-2,icg)=wang*dethetai
3597 c-----------------------------------------------------------------------------
3598 subroutine esc(escloc)
3599 C Calculate the local energy of a side chain and its derivatives in the
3600 C corresponding virtual-bond valence angles THETA and the spherical angles
3602 implicit real*8 (a-h,o-z)
3603 include 'DIMENSIONS'
3604 include 'DIMENSIONS.ZSCOPT'
3605 include 'COMMON.GEO'
3606 include 'COMMON.LOCAL'
3607 include 'COMMON.VAR'
3608 include 'COMMON.INTERACT'
3609 include 'COMMON.DERIV'
3610 include 'COMMON.CHAIN'
3611 include 'COMMON.IOUNITS'
3612 include 'COMMON.NAMES'
3613 include 'COMMON.FFIELD'
3614 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3615 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3616 common /sccalc/ time11,time12,time112,theti,it,nlobit
3619 c write (iout,'(a)') 'ESC'
3620 do i=loc_start,loc_end
3622 if (it.eq.10) goto 1
3624 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3625 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3626 theti=theta(i+1)-pipol
3630 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3632 if (x(2).gt.pi-delta) then
3636 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3638 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3639 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3641 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3642 & ddersc0(1),dersc(1))
3643 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3644 & ddersc0(3),dersc(3))
3646 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3648 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3649 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3650 & dersc0(2),esclocbi,dersc02)
3651 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3653 call splinthet(x(2),0.5d0*delta,ss,ssd)
3658 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3660 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3661 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3663 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3665 c write (iout,*) escloci
3666 else if (x(2).lt.delta) then
3670 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3672 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3673 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3675 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3676 & ddersc0(1),dersc(1))
3677 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3678 & ddersc0(3),dersc(3))
3680 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3682 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3683 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3684 & dersc0(2),esclocbi,dersc02)
3685 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3690 call splinthet(x(2),0.5d0*delta,ss,ssd)
3692 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3694 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3695 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3697 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3698 c write (iout,*) escloci
3700 call enesc(x,escloci,dersc,ddummy,.false.)
3703 escloc=escloc+escloci
3704 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3706 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3708 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3709 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3714 C---------------------------------------------------------------------------
3715 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3716 implicit real*8 (a-h,o-z)
3717 include 'DIMENSIONS'
3718 include 'COMMON.GEO'
3719 include 'COMMON.LOCAL'
3720 include 'COMMON.IOUNITS'
3721 common /sccalc/ time11,time12,time112,theti,it,nlobit
3722 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3723 double precision contr(maxlob,-1:1)
3725 c write (iout,*) 'it=',it,' nlobit=',nlobit
3729 if (mixed) ddersc(j)=0.0d0
3733 C Because of periodicity of the dependence of the SC energy in omega we have
3734 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3735 C To avoid underflows, first compute & store the exponents.
3743 z(k)=x(k)-censc(k,j,it)
3748 Axk=Axk+gaussc(l,k,j,it)*z(l)
3754 expfac=expfac+Ax(k,j,iii)*z(k)
3762 C As in the case of ebend, we want to avoid underflows in exponentiation and
3763 C subsequent NaNs and INFs in energy calculation.
3764 C Find the largest exponent
3768 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3772 cd print *,'it=',it,' emin=',emin
3774 C Compute the contribution to SC energy and derivatives
3778 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3779 cd print *,'j=',j,' expfac=',expfac
3780 escloc_i=escloc_i+expfac
3782 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3786 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3787 & +gaussc(k,2,j,it))*expfac
3794 dersc(1)=dersc(1)/cos(theti)**2
3795 ddersc(1)=ddersc(1)/cos(theti)**2
3798 escloci=-(dlog(escloc_i)-emin)
3800 dersc(j)=dersc(j)/escloc_i
3804 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3809 C------------------------------------------------------------------------------
3810 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3811 implicit real*8 (a-h,o-z)
3812 include 'DIMENSIONS'
3813 include 'COMMON.GEO'
3814 include 'COMMON.LOCAL'
3815 include 'COMMON.IOUNITS'
3816 common /sccalc/ time11,time12,time112,theti,it,nlobit
3817 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3818 double precision contr(maxlob)
3829 z(k)=x(k)-censc(k,j,it)
3835 Axk=Axk+gaussc(l,k,j,it)*z(l)
3841 expfac=expfac+Ax(k,j)*z(k)
3846 C As in the case of ebend, we want to avoid underflows in exponentiation and
3847 C subsequent NaNs and INFs in energy calculation.
3848 C Find the largest exponent
3851 if (emin.gt.contr(j)) emin=contr(j)
3855 C Compute the contribution to SC energy and derivatives
3859 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3860 escloc_i=escloc_i+expfac
3862 dersc(k)=dersc(k)+Ax(k,j)*expfac
3864 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3865 & +gaussc(1,2,j,it))*expfac
3869 dersc(1)=dersc(1)/cos(theti)**2
3870 dersc12=dersc12/cos(theti)**2
3871 escloci=-(dlog(escloc_i)-emin)
3873 dersc(j)=dersc(j)/escloc_i
3875 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3879 c----------------------------------------------------------------------------------
3880 subroutine esc(escloc)
3881 C Calculate the local energy of a side chain and its derivatives in the
3882 C corresponding virtual-bond valence angles THETA and the spherical angles
3883 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3884 C added by Urszula Kozlowska. 07/11/2007
3886 implicit real*8 (a-h,o-z)
3887 include 'DIMENSIONS'
3888 include 'DIMENSIONS.ZSCOPT'
3889 include 'COMMON.GEO'
3890 include 'COMMON.LOCAL'
3891 include 'COMMON.VAR'
3892 include 'COMMON.SCROT'
3893 include 'COMMON.INTERACT'
3894 include 'COMMON.DERIV'
3895 include 'COMMON.CHAIN'
3896 include 'COMMON.IOUNITS'
3897 include 'COMMON.NAMES'
3898 include 'COMMON.FFIELD'
3899 include 'COMMON.CONTROL'
3900 include 'COMMON.VECTORS'
3901 double precision x_prime(3),y_prime(3),z_prime(3)
3902 & , sumene,dsc_i,dp2_i,x(65),
3903 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3904 & de_dxx,de_dyy,de_dzz,de_dt
3905 double precision s1_t,s1_6_t,s2_t,s2_6_t
3907 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3908 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3909 & dt_dCi(3),dt_dCi1(3)
3910 common /sccalc/ time11,time12,time112,theti,it,nlobit
3913 do i=loc_start,loc_end
3914 costtab(i+1) =dcos(theta(i+1))
3915 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3916 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3917 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3918 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3919 cosfac=dsqrt(cosfac2)
3920 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3921 sinfac=dsqrt(sinfac2)
3923 if (it.eq.10) goto 1
3925 C Compute the axes of tghe local cartesian coordinates system; store in
3926 c x_prime, y_prime and z_prime
3933 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3934 C & dc_norm(3,i+nres)
3936 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3937 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3940 z_prime(j) = -uz(j,i-1)
3943 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3944 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3945 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3946 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3947 c & " xy",scalar(x_prime(1),y_prime(1)),
3948 c & " xz",scalar(x_prime(1),z_prime(1)),
3949 c & " yy",scalar(y_prime(1),y_prime(1)),
3950 c & " yz",scalar(y_prime(1),z_prime(1)),
3951 c & " zz",scalar(z_prime(1),z_prime(1))
3953 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3954 C to local coordinate system. Store in xx, yy, zz.
3960 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3961 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3962 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3969 C Compute the energy of the ith side cbain
3971 c write (2,*) "xx",xx," yy",yy," zz",zz
3974 x(j) = sc_parmin(j,it)
3977 Cc diagnostics - remove later
3979 yy1 = dsin(alph(2))*dcos(omeg(2))
3980 zz1 = -dsin(alph(2))*dsin(omeg(2))
3981 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3982 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3984 C," --- ", xx_w,yy_w,zz_w
3987 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3988 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3990 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3991 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3993 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3994 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3995 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3996 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3997 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3999 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4000 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4001 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4002 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4003 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4005 dsc_i = 0.743d0+x(61)
4007 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4008 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4009 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4010 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4011 s1=(1+x(63))/(0.1d0 + dscp1)
4012 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4013 s2=(1+x(65))/(0.1d0 + dscp2)
4014 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4015 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4016 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4017 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4019 c & dscp1,dscp2,sumene
4020 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4021 escloc = escloc + sumene
4022 c write (2,*) "escloc",escloc
4023 if (.not. calc_grad) goto 1
4027 C This section to check the numerical derivatives of the energy of ith side
4028 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4029 C #define DEBUG in the code to turn it on.
4031 write (2,*) "sumene =",sumene
4035 write (2,*) xx,yy,zz
4036 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4037 de_dxx_num=(sumenep-sumene)/aincr
4039 write (2,*) "xx+ sumene from enesc=",sumenep
4042 write (2,*) xx,yy,zz
4043 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4044 de_dyy_num=(sumenep-sumene)/aincr
4046 write (2,*) "yy+ sumene from enesc=",sumenep
4049 write (2,*) xx,yy,zz
4050 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4051 de_dzz_num=(sumenep-sumene)/aincr
4053 write (2,*) "zz+ sumene from enesc=",sumenep
4054 costsave=cost2tab(i+1)
4055 sintsave=sint2tab(i+1)
4056 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4057 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4058 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4059 de_dt_num=(sumenep-sumene)/aincr
4060 write (2,*) " t+ sumene from enesc=",sumenep
4061 cost2tab(i+1)=costsave
4062 sint2tab(i+1)=sintsave
4063 C End of diagnostics section.
4066 C Compute the gradient of esc
4068 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4069 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4070 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4071 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4072 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4073 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4074 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4075 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4076 pom1=(sumene3*sint2tab(i+1)+sumene1)
4077 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4078 pom2=(sumene4*cost2tab(i+1)+sumene2)
4079 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4080 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4081 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4082 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4084 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4085 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4086 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4088 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4089 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4090 & +(pom1+pom2)*pom_dx
4092 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4095 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4096 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4097 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4099 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4100 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4101 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4102 & +x(59)*zz**2 +x(60)*xx*zz
4103 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4104 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4105 & +(pom1-pom2)*pom_dy
4107 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4110 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4111 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4112 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4113 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4114 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4115 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4116 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4117 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4119 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4122 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4123 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4124 & +pom1*pom_dt1+pom2*pom_dt2
4126 write(2,*), "de_dt = ", de_dt,de_dt_num
4130 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4131 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4132 cosfac2xx=cosfac2*xx
4133 sinfac2yy=sinfac2*yy
4135 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4137 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4139 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4140 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4141 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4142 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4143 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4144 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4145 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4146 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4147 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4148 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4152 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4153 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4156 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4157 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4158 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4160 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4161 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4165 dXX_Ctab(k,i)=dXX_Ci(k)
4166 dXX_C1tab(k,i)=dXX_Ci1(k)
4167 dYY_Ctab(k,i)=dYY_Ci(k)
4168 dYY_C1tab(k,i)=dYY_Ci1(k)
4169 dZZ_Ctab(k,i)=dZZ_Ci(k)
4170 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4171 dXX_XYZtab(k,i)=dXX_XYZ(k)
4172 dYY_XYZtab(k,i)=dYY_XYZ(k)
4173 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4177 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4178 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4179 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4180 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4181 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4183 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4184 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4185 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4186 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4187 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4188 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4189 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4190 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4192 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4193 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4195 C to check gradient call subroutine check_grad
4202 c------------------------------------------------------------------------------
4203 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4205 C This procedure calculates two-body contact function g(rij) and its derivative:
4208 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4211 C where x=(rij-r0ij)/delta
4213 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4216 double precision rij,r0ij,eps0ij,fcont,fprimcont
4217 double precision x,x2,x4,delta
4221 if (x.lt.-1.0D0) then
4224 else if (x.le.1.0D0) then
4227 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4228 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4235 c------------------------------------------------------------------------------
4236 subroutine splinthet(theti,delta,ss,ssder)
4237 implicit real*8 (a-h,o-z)
4238 include 'DIMENSIONS'
4239 include 'DIMENSIONS.ZSCOPT'
4240 include 'COMMON.VAR'
4241 include 'COMMON.GEO'
4244 if (theti.gt.pipol) then
4245 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4247 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4252 c------------------------------------------------------------------------------
4253 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4255 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4256 double precision ksi,ksi2,ksi3,a1,a2,a3
4257 a1=fprim0*delta/(f1-f0)
4263 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4264 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4267 c------------------------------------------------------------------------------
4268 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4270 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4271 double precision ksi,ksi2,ksi3,a1,a2,a3
4276 a2=3*(f1x-f0x)-2*fprim0x*delta
4277 a3=fprim0x*delta-2*(f1x-f0x)
4278 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4281 C-----------------------------------------------------------------------------
4283 C-----------------------------------------------------------------------------
4284 subroutine etor(etors,edihcnstr,fact)
4285 implicit real*8 (a-h,o-z)
4286 include 'DIMENSIONS'
4287 include 'DIMENSIONS.ZSCOPT'
4288 include 'COMMON.VAR'
4289 include 'COMMON.GEO'
4290 include 'COMMON.LOCAL'
4291 include 'COMMON.TORSION'
4292 include 'COMMON.INTERACT'
4293 include 'COMMON.DERIV'
4294 include 'COMMON.CHAIN'
4295 include 'COMMON.NAMES'
4296 include 'COMMON.IOUNITS'
4297 include 'COMMON.FFIELD'
4298 include 'COMMON.TORCNSTR'
4300 C Set lprn=.true. for debugging
4304 do i=iphi_start,iphi_end
4305 itori=itortyp(itype(i-2))
4306 itori1=itortyp(itype(i-1))
4309 C Proline-Proline pair is a special case...
4310 if (itori.eq.3 .and. itori1.eq.3) then
4311 if (phii.gt.-dwapi3) then
4313 fac=1.0D0/(1.0D0-cosphi)
4314 etorsi=v1(1,3,3)*fac
4315 etorsi=etorsi+etorsi
4316 etors=etors+etorsi-v1(1,3,3)
4317 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4320 v1ij=v1(j+1,itori,itori1)
4321 v2ij=v2(j+1,itori,itori1)
4324 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4325 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4329 v1ij=v1(j,itori,itori1)
4330 v2ij=v2(j,itori,itori1)
4333 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4334 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4338 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4339 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4340 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4341 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4342 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4344 ! 6/20/98 - dihedral angle constraints
4347 itori=idih_constr(i)
4350 if (difi.gt.drange(i)) then
4352 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4353 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4354 else if (difi.lt.-drange(i)) then
4356 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4357 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4359 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4360 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4362 ! write (iout,*) 'edihcnstr',edihcnstr
4365 c------------------------------------------------------------------------------
4367 subroutine etor(etors,edihcnstr,fact)
4368 implicit real*8 (a-h,o-z)
4369 include 'DIMENSIONS'
4370 include 'DIMENSIONS.ZSCOPT'
4371 include 'COMMON.VAR'
4372 include 'COMMON.GEO'
4373 include 'COMMON.LOCAL'
4374 include 'COMMON.TORSION'
4375 include 'COMMON.INTERACT'
4376 include 'COMMON.DERIV'
4377 include 'COMMON.CHAIN'
4378 include 'COMMON.NAMES'
4379 include 'COMMON.IOUNITS'
4380 include 'COMMON.FFIELD'
4381 include 'COMMON.TORCNSTR'
4383 C Set lprn=.true. for debugging
4387 do i=iphi_start,iphi_end
4388 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4389 itori=itortyp(itype(i-2))
4390 itori1=itortyp(itype(i-1))
4393 C Regular cosine and sine terms
4394 do j=1,nterm(itori,itori1)
4395 v1ij=v1(j,itori,itori1)
4396 v2ij=v2(j,itori,itori1)
4399 etors=etors+v1ij*cosphi+v2ij*sinphi
4400 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4404 C E = SUM ----------------------------------- - v1
4405 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4407 cosphi=dcos(0.5d0*phii)
4408 sinphi=dsin(0.5d0*phii)
4409 do j=1,nlor(itori,itori1)
4410 vl1ij=vlor1(j,itori,itori1)
4411 vl2ij=vlor2(j,itori,itori1)
4412 vl3ij=vlor3(j,itori,itori1)
4413 pom=vl2ij*cosphi+vl3ij*sinphi
4414 pom1=1.0d0/(pom*pom+1.0d0)
4415 etors=etors+vl1ij*pom1
4417 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4419 C Subtract the constant term
4420 etors=etors-v0(itori,itori1)
4422 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4423 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4424 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4425 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4426 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4429 ! 6/20/98 - dihedral angle constraints
4432 itori=idih_constr(i)
4434 difi=pinorm(phii-phi0(i))
4436 if (difi.gt.drange(i)) then
4438 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4439 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4440 edihi=0.25d0*ftors*difi**4
4441 else if (difi.lt.-drange(i)) then
4443 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4444 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4445 edihi=0.25d0*ftors*difi**4
4449 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4451 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4452 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4454 ! write (iout,*) 'edihcnstr',edihcnstr
4457 c----------------------------------------------------------------------------
4458 subroutine etor_d(etors_d,fact2)
4459 C 6/23/01 Compute double torsional energy
4460 implicit real*8 (a-h,o-z)
4461 include 'DIMENSIONS'
4462 include 'DIMENSIONS.ZSCOPT'
4463 include 'COMMON.VAR'
4464 include 'COMMON.GEO'
4465 include 'COMMON.LOCAL'
4466 include 'COMMON.TORSION'
4467 include 'COMMON.INTERACT'
4468 include 'COMMON.DERIV'
4469 include 'COMMON.CHAIN'
4470 include 'COMMON.NAMES'
4471 include 'COMMON.IOUNITS'
4472 include 'COMMON.FFIELD'
4473 include 'COMMON.TORCNSTR'
4475 C Set lprn=.true. for debugging
4479 do i=iphi_start,iphi_end-1
4480 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4482 itori=itortyp(itype(i-2))
4483 itori1=itortyp(itype(i-1))
4484 itori2=itortyp(itype(i))
4489 C Regular cosine and sine terms
4490 do j=1,ntermd_1(itori,itori1,itori2)
4491 v1cij=v1c(1,j,itori,itori1,itori2)
4492 v1sij=v1s(1,j,itori,itori1,itori2)
4493 v2cij=v1c(2,j,itori,itori1,itori2)
4494 v2sij=v1s(2,j,itori,itori1,itori2)
4495 cosphi1=dcos(j*phii)
4496 sinphi1=dsin(j*phii)
4497 cosphi2=dcos(j*phii1)
4498 sinphi2=dsin(j*phii1)
4499 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4500 & v2cij*cosphi2+v2sij*sinphi2
4501 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4502 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4504 do k=2,ntermd_2(itori,itori1,itori2)
4506 v1cdij = v2c(k,l,itori,itori1,itori2)
4507 v2cdij = v2c(l,k,itori,itori1,itori2)
4508 v1sdij = v2s(k,l,itori,itori1,itori2)
4509 v2sdij = v2s(l,k,itori,itori1,itori2)
4510 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4511 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4512 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4513 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4514 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4515 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4516 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4517 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4518 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4519 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4522 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4523 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4529 c------------------------------------------------------------------------------
4530 subroutine eback_sc_corr(esccor)
4531 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4532 c conformational states; temporarily implemented as differences
4533 c between UNRES torsional potentials (dependent on three types of
4534 c residues) and the torsional potentials dependent on all 20 types
4535 c of residues computed from AM1 energy surfaces of terminally-blocked
4536 c amino-acid residues.
4537 implicit real*8 (a-h,o-z)
4538 include 'DIMENSIONS'
4539 include 'DIMENSIONS.ZSCOPT'
4540 include 'COMMON.VAR'
4541 include 'COMMON.GEO'
4542 include 'COMMON.LOCAL'
4543 include 'COMMON.TORSION'
4544 include 'COMMON.SCCOR'
4545 include 'COMMON.INTERACT'
4546 include 'COMMON.DERIV'
4547 include 'COMMON.CHAIN'
4548 include 'COMMON.NAMES'
4549 include 'COMMON.IOUNITS'
4550 include 'COMMON.FFIELD'
4551 include 'COMMON.CONTROL'
4553 C Set lprn=.true. for debugging
4556 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
4558 do i=itau_start,itau_end
4560 isccori=isccortyp(itype(i-2))
4561 isccori1=isccortyp(itype(i-1))
4563 cccc Added 9 May 2012
4564 cc Tauangle is torsional engle depending on the value of first digit
4565 c(see comment below)
4566 cc Omicron is flat angle depending on the value of first digit
4567 c(see comment below)
4570 do intertyp=1,3 !intertyp
4571 cc Added 09 May 2012 (Adasko)
4572 cc Intertyp means interaction type of backbone mainchain correlation:
4573 c 1 = SC...Ca...Ca...Ca
4574 c 2 = Ca...Ca...Ca...SC
4575 c 3 = SC...Ca...Ca...SCi
4577 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4578 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4579 & (itype(i-1).eq.21)))
4580 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4581 & .or.(itype(i-2).eq.21)))
4582 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4583 & (itype(i-1).eq.21)))) cycle
4584 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4585 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4587 do j=1,nterm_sccor(isccori,isccori1)
4588 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4589 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4590 cosphi=dcos(j*tauangle(intertyp,i))
4591 sinphi=dsin(j*tauangle(intertyp,i))
4592 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4593 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4595 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4596 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4597 c &gloc_sc(intertyp,i-3,icg)
4599 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4600 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4601 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4602 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4603 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4607 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
4611 c------------------------------------------------------------------------------
4612 subroutine multibody(ecorr)
4613 C This subroutine calculates multi-body contributions to energy following
4614 C the idea of Skolnick et al. If side chains I and J make a contact and
4615 C at the same time side chains I+1 and J+1 make a contact, an extra
4616 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4617 implicit real*8 (a-h,o-z)
4618 include 'DIMENSIONS'
4619 include 'COMMON.IOUNITS'
4620 include 'COMMON.DERIV'
4621 include 'COMMON.INTERACT'
4622 include 'COMMON.CONTACTS'
4623 double precision gx(3),gx1(3)
4626 C Set lprn=.true. for debugging
4630 write (iout,'(a)') 'Contact function values:'
4632 write (iout,'(i2,20(1x,i2,f10.5))')
4633 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4648 num_conti=num_cont(i)
4649 num_conti1=num_cont(i1)
4654 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4655 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4656 cd & ' ishift=',ishift
4657 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4658 C The system gains extra energy.
4659 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4660 endif ! j1==j+-ishift
4669 c------------------------------------------------------------------------------
4670 double precision function esccorr(i,j,k,l,jj,kk)
4671 implicit real*8 (a-h,o-z)
4672 include 'DIMENSIONS'
4673 include 'COMMON.IOUNITS'
4674 include 'COMMON.DERIV'
4675 include 'COMMON.INTERACT'
4676 include 'COMMON.CONTACTS'
4677 double precision gx(3),gx1(3)
4682 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4683 C Calculate the multi-body contribution to energy.
4684 C Calculate multi-body contributions to the gradient.
4685 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4686 cd & k,l,(gacont(m,kk,k),m=1,3)
4688 gx(m) =ekl*gacont(m,jj,i)
4689 gx1(m)=eij*gacont(m,kk,k)
4690 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4691 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4692 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4693 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4697 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4702 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4708 c------------------------------------------------------------------------------
4710 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4711 implicit real*8 (a-h,o-z)
4712 include 'DIMENSIONS'
4713 integer dimen1,dimen2,atom,indx
4714 double precision buffer(dimen1,dimen2)
4715 double precision zapas
4716 common /contacts_hb/ zapas(3,20,maxres,7),
4717 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4718 & num_cont_hb(maxres),jcont_hb(20,maxres)
4719 num_kont=num_cont_hb(atom)
4723 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4726 buffer(i,indx+22)=facont_hb(i,atom)
4727 buffer(i,indx+23)=ees0p(i,atom)
4728 buffer(i,indx+24)=ees0m(i,atom)
4729 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4731 buffer(1,indx+26)=dfloat(num_kont)
4734 c------------------------------------------------------------------------------
4735 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4736 implicit real*8 (a-h,o-z)
4737 include 'DIMENSIONS'
4738 integer dimen1,dimen2,atom,indx
4739 double precision buffer(dimen1,dimen2)
4740 double precision zapas
4741 common /contacts_hb/ zapas(3,20,maxres,7),
4742 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4743 & num_cont_hb(maxres),jcont_hb(20,maxres)
4744 num_kont=buffer(1,indx+26)
4745 num_kont_old=num_cont_hb(atom)
4746 num_cont_hb(atom)=num_kont+num_kont_old
4751 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4754 facont_hb(ii,atom)=buffer(i,indx+22)
4755 ees0p(ii,atom)=buffer(i,indx+23)
4756 ees0m(ii,atom)=buffer(i,indx+24)
4757 jcont_hb(ii,atom)=buffer(i,indx+25)
4761 c------------------------------------------------------------------------------
4763 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4764 C This subroutine calculates multi-body contributions to hydrogen-bonding
4765 implicit real*8 (a-h,o-z)
4766 include 'DIMENSIONS'
4767 include 'DIMENSIONS.ZSCOPT'
4768 include 'COMMON.IOUNITS'
4770 include 'COMMON.INFO'
4772 include 'COMMON.FFIELD'
4773 include 'COMMON.DERIV'
4774 include 'COMMON.INTERACT'
4775 include 'COMMON.CONTACTS'
4777 parameter (max_cont=maxconts)
4778 parameter (max_dim=2*(8*3+2))
4779 parameter (msglen1=max_cont*max_dim*4)
4780 parameter (msglen2=2*msglen1)
4781 integer source,CorrelType,CorrelID,Error
4782 double precision buffer(max_cont,max_dim)
4784 double precision gx(3),gx1(3)
4787 C Set lprn=.true. for debugging
4792 if (fgProcs.le.1) goto 30
4794 write (iout,'(a)') 'Contact function values:'
4796 write (iout,'(2i3,50(1x,i2,f5.2))')
4797 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4798 & j=1,num_cont_hb(i))
4801 C Caution! Following code assumes that electrostatic interactions concerning
4802 C a given atom are split among at most two processors!
4812 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4815 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4816 if (MyRank.gt.0) then
4817 C Send correlation contributions to the preceding processor
4819 nn=num_cont_hb(iatel_s)
4820 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4821 cd write (iout,*) 'The BUFFER array:'
4823 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4825 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4827 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4828 C Clear the contacts of the atom passed to the neighboring processor
4829 nn=num_cont_hb(iatel_s+1)
4831 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4833 num_cont_hb(iatel_s)=0
4835 cd write (iout,*) 'Processor ',MyID,MyRank,
4836 cd & ' is sending correlation contribution to processor',MyID-1,
4837 cd & ' msglen=',msglen
4838 cd write (*,*) 'Processor ',MyID,MyRank,
4839 cd & ' is sending correlation contribution to processor',MyID-1,
4840 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4841 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4842 cd write (iout,*) 'Processor ',MyID,
4843 cd & ' has sent correlation contribution to processor',MyID-1,
4844 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4845 cd write (*,*) 'Processor ',MyID,
4846 cd & ' has sent correlation contribution to processor',MyID-1,
4847 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4849 endif ! (MyRank.gt.0)
4853 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4854 if (MyRank.lt.fgProcs-1) then
4855 C Receive correlation contributions from the next processor
4857 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4858 cd write (iout,*) 'Processor',MyID,
4859 cd & ' is receiving correlation contribution from processor',MyID+1,
4860 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4861 cd write (*,*) 'Processor',MyID,
4862 cd & ' is receiving correlation contribution from processor',MyID+1,
4863 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4865 do while (nbytes.le.0)
4866 call mp_probe(MyID+1,CorrelType,nbytes)
4868 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4869 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4870 cd write (iout,*) 'Processor',MyID,
4871 cd & ' has received correlation contribution from processor',MyID+1,
4872 cd & ' msglen=',msglen,' nbytes=',nbytes
4873 cd write (iout,*) 'The received BUFFER array:'
4875 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4877 if (msglen.eq.msglen1) then
4878 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4879 else if (msglen.eq.msglen2) then
4880 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4881 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4884 & 'ERROR!!!! message length changed while processing correlations.'
4886 & 'ERROR!!!! message length changed while processing correlations.'
4887 call mp_stopall(Error)
4888 endif ! msglen.eq.msglen1
4889 endif ! MyRank.lt.fgProcs-1
4896 write (iout,'(a)') 'Contact function values:'
4898 write (iout,'(2i3,50(1x,i2,f5.2))')
4899 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4900 & j=1,num_cont_hb(i))
4904 C Remove the loop below after debugging !!!
4911 C Calculate the local-electrostatic correlation terms
4912 do i=iatel_s,iatel_e+1
4914 num_conti=num_cont_hb(i)
4915 num_conti1=num_cont_hb(i+1)
4920 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4921 c & ' jj=',jj,' kk=',kk
4922 if (j1.eq.j+1 .or. j1.eq.j-1) then
4923 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4924 C The system gains extra energy.
4925 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4927 else if (j1.eq.j) then
4928 C Contacts I-J and I-(J+1) occur simultaneously.
4929 C The system loses extra energy.
4930 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4935 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4936 c & ' jj=',jj,' kk=',kk
4938 C Contacts I-J and (I+1)-J occur simultaneously.
4939 C The system loses extra energy.
4940 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4947 c------------------------------------------------------------------------------
4948 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4950 C This subroutine calculates multi-body contributions to hydrogen-bonding
4951 implicit real*8 (a-h,o-z)
4952 include 'DIMENSIONS'
4953 include 'DIMENSIONS.ZSCOPT'
4954 include 'COMMON.IOUNITS'
4956 include 'COMMON.INFO'
4958 include 'COMMON.FFIELD'
4959 include 'COMMON.DERIV'
4960 include 'COMMON.INTERACT'
4961 include 'COMMON.CONTACTS'
4963 parameter (max_cont=maxconts)
4964 parameter (max_dim=2*(8*3+2))
4965 parameter (msglen1=max_cont*max_dim*4)
4966 parameter (msglen2=2*msglen1)
4967 integer source,CorrelType,CorrelID,Error
4968 double precision buffer(max_cont,max_dim)
4970 double precision gx(3),gx1(3)
4973 C Set lprn=.true. for debugging
4979 if (fgProcs.le.1) goto 30
4981 write (iout,'(a)') 'Contact function values:'
4983 write (iout,'(2i3,50(1x,i2,f5.2))')
4984 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4985 & j=1,num_cont_hb(i))
4988 C Caution! Following code assumes that electrostatic interactions concerning
4989 C a given atom are split among at most two processors!
4999 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5002 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5003 if (MyRank.gt.0) then
5004 C Send correlation contributions to the preceding processor
5006 nn=num_cont_hb(iatel_s)
5007 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5008 cd write (iout,*) 'The BUFFER array:'
5010 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5012 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5014 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5015 C Clear the contacts of the atom passed to the neighboring processor
5016 nn=num_cont_hb(iatel_s+1)
5018 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5020 num_cont_hb(iatel_s)=0
5022 cd write (iout,*) 'Processor ',MyID,MyRank,
5023 cd & ' is sending correlation contribution to processor',MyID-1,
5024 cd & ' msglen=',msglen
5025 cd write (*,*) 'Processor ',MyID,MyRank,
5026 cd & ' is sending correlation contribution to processor',MyID-1,
5027 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5028 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5029 cd write (iout,*) 'Processor ',MyID,
5030 cd & ' has sent correlation contribution to processor',MyID-1,
5031 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5032 cd write (*,*) 'Processor ',MyID,
5033 cd & ' has sent correlation contribution to processor',MyID-1,
5034 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5036 endif ! (MyRank.gt.0)
5040 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5041 if (MyRank.lt.fgProcs-1) then
5042 C Receive correlation contributions from the next processor
5044 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5045 cd write (iout,*) 'Processor',MyID,
5046 cd & ' is receiving correlation contribution from processor',MyID+1,
5047 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5048 cd write (*,*) 'Processor',MyID,
5049 cd & ' is receiving correlation contribution from processor',MyID+1,
5050 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5052 do while (nbytes.le.0)
5053 call mp_probe(MyID+1,CorrelType,nbytes)
5055 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5056 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5057 cd write (iout,*) 'Processor',MyID,
5058 cd & ' has received correlation contribution from processor',MyID+1,
5059 cd & ' msglen=',msglen,' nbytes=',nbytes
5060 cd write (iout,*) 'The received BUFFER array:'
5062 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5064 if (msglen.eq.msglen1) then
5065 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5066 else if (msglen.eq.msglen2) then
5067 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5068 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5071 & 'ERROR!!!! message length changed while processing correlations.'
5073 & 'ERROR!!!! message length changed while processing correlations.'
5074 call mp_stopall(Error)
5075 endif ! msglen.eq.msglen1
5076 endif ! MyRank.lt.fgProcs-1
5083 write (iout,'(a)') 'Contact function values:'
5085 write (iout,'(2i3,50(1x,i2,f5.2))')
5086 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5087 & j=1,num_cont_hb(i))
5093 C Remove the loop below after debugging !!!
5100 C Calculate the dipole-dipole interaction energies
5101 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5102 do i=iatel_s,iatel_e+1
5103 num_conti=num_cont_hb(i)
5110 C Calculate the local-electrostatic correlation terms
5111 do i=iatel_s,iatel_e+1
5113 num_conti=num_cont_hb(i)
5114 num_conti1=num_cont_hb(i+1)
5119 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5120 c & ' jj=',jj,' kk=',kk
5121 if (j1.eq.j+1 .or. j1.eq.j-1) then
5122 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5123 C The system gains extra energy.
5125 sqd1=dsqrt(d_cont(jj,i))
5126 sqd2=dsqrt(d_cont(kk,i1))
5127 sred_geom = sqd1*sqd2
5128 IF (sred_geom.lt.cutoff_corr) THEN
5129 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5131 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5132 c & ' jj=',jj,' kk=',kk
5133 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5134 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5136 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5137 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5140 cd write (iout,*) 'sred_geom=',sred_geom,
5141 cd & ' ekont=',ekont,' fprim=',fprimcont
5142 call calc_eello(i,j,i+1,j1,jj,kk)
5143 if (wcorr4.gt.0.0d0)
5144 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5145 if (wcorr5.gt.0.0d0)
5146 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5147 c print *,"wcorr5",ecorr5
5148 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5149 cd write(2,*)'ijkl',i,j,i+1,j1
5150 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5151 & .or. wturn6.eq.0.0d0))then
5152 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5153 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5154 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5155 cd & 'ecorr6=',ecorr6
5156 cd write (iout,'(4e15.5)') sred_geom,
5157 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5158 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5159 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5160 else if (wturn6.gt.0.0d0
5161 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5162 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5163 eturn6=eturn6+eello_turn6(i,jj,kk)
5164 cd write (2,*) 'multibody_eello:eturn6',eturn6
5168 else if (j1.eq.j) then
5169 C Contacts I-J and I-(J+1) occur simultaneously.
5170 C The system loses extra energy.
5171 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5176 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5177 c & ' jj=',jj,' kk=',kk
5179 C Contacts I-J and (I+1)-J occur simultaneously.
5180 C The system loses extra energy.
5181 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5188 c------------------------------------------------------------------------------
5189 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5190 implicit real*8 (a-h,o-z)
5191 include 'DIMENSIONS'
5192 include 'COMMON.IOUNITS'
5193 include 'COMMON.DERIV'
5194 include 'COMMON.INTERACT'
5195 include 'COMMON.CONTACTS'
5196 double precision gx(3),gx1(3)
5206 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5207 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5208 C Following 4 lines for diagnostics.
5213 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5215 c write (iout,*)'Contacts have occurred for peptide groups',
5216 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5217 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5218 C Calculate the multi-body contribution to energy.
5219 ecorr=ecorr+ekont*ees
5221 C Calculate multi-body contributions to the gradient.
5223 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5224 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5225 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5226 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5227 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5228 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5229 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5230 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5231 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5232 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5233 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5234 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5235 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5236 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5240 gradcorr(ll,m)=gradcorr(ll,m)+
5241 & ees*ekl*gacont_hbr(ll,jj,i)-
5242 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5243 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5248 gradcorr(ll,m)=gradcorr(ll,m)+
5249 & ees*eij*gacont_hbr(ll,kk,k)-
5250 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5251 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5258 C---------------------------------------------------------------------------
5259 subroutine dipole(i,j,jj)
5260 implicit real*8 (a-h,o-z)
5261 include 'DIMENSIONS'
5262 include 'DIMENSIONS.ZSCOPT'
5263 include 'COMMON.IOUNITS'
5264 include 'COMMON.CHAIN'
5265 include 'COMMON.FFIELD'
5266 include 'COMMON.DERIV'
5267 include 'COMMON.INTERACT'
5268 include 'COMMON.CONTACTS'
5269 include 'COMMON.TORSION'
5270 include 'COMMON.VAR'
5271 include 'COMMON.GEO'
5272 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5274 iti1 = itortyp(itype(i+1))
5275 if (j.lt.nres-1) then
5276 itj1 = itortyp(itype(j+1))
5281 dipi(iii,1)=Ub2(iii,i)
5282 dipderi(iii)=Ub2der(iii,i)
5283 dipi(iii,2)=b1(iii,iti1)
5284 dipj(iii,1)=Ub2(iii,j)
5285 dipderj(iii)=Ub2der(iii,j)
5286 dipj(iii,2)=b1(iii,itj1)
5290 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5293 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5296 if (.not.calc_grad) return
5301 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5305 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5310 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5311 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5313 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5315 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5317 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5321 C---------------------------------------------------------------------------
5322 subroutine calc_eello(i,j,k,l,jj,kk)
5324 C This subroutine computes matrices and vectors needed to calculate
5325 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5327 implicit real*8 (a-h,o-z)
5328 include 'DIMENSIONS'
5329 include 'DIMENSIONS.ZSCOPT'
5330 include 'COMMON.IOUNITS'
5331 include 'COMMON.CHAIN'
5332 include 'COMMON.DERIV'
5333 include 'COMMON.INTERACT'
5334 include 'COMMON.CONTACTS'
5335 include 'COMMON.TORSION'
5336 include 'COMMON.VAR'
5337 include 'COMMON.GEO'
5338 include 'COMMON.FFIELD'
5339 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5340 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5343 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5344 cd & ' jj=',jj,' kk=',kk
5345 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5348 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5349 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5352 call transpose2(aa1(1,1),aa1t(1,1))
5353 call transpose2(aa2(1,1),aa2t(1,1))
5356 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5357 & aa1tder(1,1,lll,kkk))
5358 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5359 & aa2tder(1,1,lll,kkk))
5363 C parallel orientation of the two CA-CA-CA frames.
5365 iti=itortyp(itype(i))
5369 itk1=itortyp(itype(k+1))
5370 itj=itortyp(itype(j))
5371 if (l.lt.nres-1) then
5372 itl1=itortyp(itype(l+1))
5376 C A1 kernel(j+1) A2T
5378 cd write (iout,'(3f10.5,5x,3f10.5)')
5379 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5381 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5382 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5383 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5384 C Following matrices are needed only for 6-th order cumulants
5385 IF (wcorr6.gt.0.0d0) THEN
5386 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5387 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5388 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5389 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5390 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5391 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5392 & ADtEAderx(1,1,1,1,1,1))
5394 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5395 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5396 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5397 & ADtEA1derx(1,1,1,1,1,1))
5399 C End 6-th order cumulants
5402 cd write (2,*) 'In calc_eello6'
5404 cd write (2,*) 'iii=',iii
5406 cd write (2,*) 'kkk=',kkk
5408 cd write (2,'(3(2f10.5),5x)')
5409 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5414 call transpose2(EUgder(1,1,k),auxmat(1,1))
5415 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5416 call transpose2(EUg(1,1,k),auxmat(1,1))
5417 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5418 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5422 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5423 & EAEAderx(1,1,lll,kkk,iii,1))
5427 C A1T kernel(i+1) A2
5428 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5429 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5430 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5431 C Following matrices are needed only for 6-th order cumulants
5432 IF (wcorr6.gt.0.0d0) THEN
5433 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5434 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5435 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5436 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5437 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5438 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5439 & ADtEAderx(1,1,1,1,1,2))
5440 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5441 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5442 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5443 & ADtEA1derx(1,1,1,1,1,2))
5445 C End 6-th order cumulants
5446 call transpose2(EUgder(1,1,l),auxmat(1,1))
5447 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5448 call transpose2(EUg(1,1,l),auxmat(1,1))
5449 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5450 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5454 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5455 & EAEAderx(1,1,lll,kkk,iii,2))
5460 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5461 C They are needed only when the fifth- or the sixth-order cumulants are
5463 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5464 call transpose2(AEA(1,1,1),auxmat(1,1))
5465 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5466 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5467 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5468 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5469 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5470 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5471 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5472 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5473 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5474 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5475 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5476 call transpose2(AEA(1,1,2),auxmat(1,1))
5477 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5478 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5479 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5480 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5481 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5482 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5483 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5484 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5485 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5486 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5487 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5488 C Calculate the Cartesian derivatives of the vectors.
5492 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5493 call matvec2(auxmat(1,1),b1(1,iti),
5494 & AEAb1derx(1,lll,kkk,iii,1,1))
5495 call matvec2(auxmat(1,1),Ub2(1,i),
5496 & AEAb2derx(1,lll,kkk,iii,1,1))
5497 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5498 & AEAb1derx(1,lll,kkk,iii,2,1))
5499 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5500 & AEAb2derx(1,lll,kkk,iii,2,1))
5501 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5502 call matvec2(auxmat(1,1),b1(1,itj),
5503 & AEAb1derx(1,lll,kkk,iii,1,2))
5504 call matvec2(auxmat(1,1),Ub2(1,j),
5505 & AEAb2derx(1,lll,kkk,iii,1,2))
5506 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5507 & AEAb1derx(1,lll,kkk,iii,2,2))
5508 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5509 & AEAb2derx(1,lll,kkk,iii,2,2))
5516 C Antiparallel orientation of the two CA-CA-CA frames.
5518 iti=itortyp(itype(i))
5522 itk1=itortyp(itype(k+1))
5523 itl=itortyp(itype(l))
5524 itj=itortyp(itype(j))
5525 if (j.lt.nres-1) then
5526 itj1=itortyp(itype(j+1))
5530 C A2 kernel(j-1)T A1T
5531 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5532 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5533 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5534 C Following matrices are needed only for 6-th order cumulants
5535 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5536 & j.eq.i+4 .and. l.eq.i+3)) THEN
5537 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5538 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5539 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5540 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5541 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5542 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5543 & ADtEAderx(1,1,1,1,1,1))
5544 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5545 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5546 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5547 & ADtEA1derx(1,1,1,1,1,1))
5549 C End 6-th order cumulants
5550 call transpose2(EUgder(1,1,k),auxmat(1,1))
5551 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5552 call transpose2(EUg(1,1,k),auxmat(1,1))
5553 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5554 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5558 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5559 & EAEAderx(1,1,lll,kkk,iii,1))
5563 C A2T kernel(i+1)T A1
5564 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5565 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5566 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5567 C Following matrices are needed only for 6-th order cumulants
5568 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5569 & j.eq.i+4 .and. l.eq.i+3)) THEN
5570 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5571 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5572 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5573 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5574 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5575 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5576 & ADtEAderx(1,1,1,1,1,2))
5577 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5578 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5579 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5580 & ADtEA1derx(1,1,1,1,1,2))
5582 C End 6-th order cumulants
5583 call transpose2(EUgder(1,1,j),auxmat(1,1))
5584 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5585 call transpose2(EUg(1,1,j),auxmat(1,1))
5586 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5587 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5591 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5592 & EAEAderx(1,1,lll,kkk,iii,2))
5597 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5598 C They are needed only when the fifth- or the sixth-order cumulants are
5600 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5601 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5602 call transpose2(AEA(1,1,1),auxmat(1,1))
5603 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5604 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5605 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5606 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5607 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5608 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5609 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5610 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5611 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5612 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5613 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5614 call transpose2(AEA(1,1,2),auxmat(1,1))
5615 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5616 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5617 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5618 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5619 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5620 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5621 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5622 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5623 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5624 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5625 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5626 C Calculate the Cartesian derivatives of the vectors.
5630 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5631 call matvec2(auxmat(1,1),b1(1,iti),
5632 & AEAb1derx(1,lll,kkk,iii,1,1))
5633 call matvec2(auxmat(1,1),Ub2(1,i),
5634 & AEAb2derx(1,lll,kkk,iii,1,1))
5635 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5636 & AEAb1derx(1,lll,kkk,iii,2,1))
5637 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5638 & AEAb2derx(1,lll,kkk,iii,2,1))
5639 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5640 call matvec2(auxmat(1,1),b1(1,itl),
5641 & AEAb1derx(1,lll,kkk,iii,1,2))
5642 call matvec2(auxmat(1,1),Ub2(1,l),
5643 & AEAb2derx(1,lll,kkk,iii,1,2))
5644 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5645 & AEAb1derx(1,lll,kkk,iii,2,2))
5646 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5647 & AEAb2derx(1,lll,kkk,iii,2,2))
5656 C---------------------------------------------------------------------------
5657 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5658 & KK,KKderg,AKA,AKAderg,AKAderx)
5662 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5663 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5664 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5669 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5671 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5674 cd if (lprn) write (2,*) 'In kernel'
5676 cd if (lprn) write (2,*) 'kkk=',kkk
5678 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5679 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5681 cd write (2,*) 'lll=',lll
5682 cd write (2,*) 'iii=1'
5684 cd write (2,'(3(2f10.5),5x)')
5685 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5688 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5689 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5691 cd write (2,*) 'lll=',lll
5692 cd write (2,*) 'iii=2'
5694 cd write (2,'(3(2f10.5),5x)')
5695 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5702 C---------------------------------------------------------------------------
5703 double precision function eello4(i,j,k,l,jj,kk)
5704 implicit real*8 (a-h,o-z)
5705 include 'DIMENSIONS'
5706 include 'DIMENSIONS.ZSCOPT'
5707 include 'COMMON.IOUNITS'
5708 include 'COMMON.CHAIN'
5709 include 'COMMON.DERIV'
5710 include 'COMMON.INTERACT'
5711 include 'COMMON.CONTACTS'
5712 include 'COMMON.TORSION'
5713 include 'COMMON.VAR'
5714 include 'COMMON.GEO'
5715 double precision pizda(2,2),ggg1(3),ggg2(3)
5716 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5720 cd print *,'eello4:',i,j,k,l,jj,kk
5721 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5722 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5723 cold eij=facont_hb(jj,i)
5724 cold ekl=facont_hb(kk,k)
5726 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5728 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5729 gcorr_loc(k-1)=gcorr_loc(k-1)
5730 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5732 gcorr_loc(l-1)=gcorr_loc(l-1)
5733 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5735 gcorr_loc(j-1)=gcorr_loc(j-1)
5736 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5741 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5742 & -EAEAderx(2,2,lll,kkk,iii,1)
5743 cd derx(lll,kkk,iii)=0.0d0
5747 cd gcorr_loc(l-1)=0.0d0
5748 cd gcorr_loc(j-1)=0.0d0
5749 cd gcorr_loc(k-1)=0.0d0
5751 cd write (iout,*)'Contacts have occurred for peptide groups',
5752 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5753 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5754 if (j.lt.nres-1) then
5761 if (l.lt.nres-1) then
5769 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5770 ggg1(ll)=eel4*g_contij(ll,1)
5771 ggg2(ll)=eel4*g_contij(ll,2)
5772 ghalf=0.5d0*ggg1(ll)
5774 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5775 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5776 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5777 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5778 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5779 ghalf=0.5d0*ggg2(ll)
5781 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5782 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5783 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5784 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5789 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5790 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5795 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5796 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5802 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5807 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5811 cd write (2,*) iii,gcorr_loc(iii)
5815 cd write (2,*) 'ekont',ekont
5816 cd write (iout,*) 'eello4',ekont*eel4
5819 C---------------------------------------------------------------------------
5820 double precision function eello5(i,j,k,l,jj,kk)
5821 implicit real*8 (a-h,o-z)
5822 include 'DIMENSIONS'
5823 include 'DIMENSIONS.ZSCOPT'
5824 include 'COMMON.IOUNITS'
5825 include 'COMMON.CHAIN'
5826 include 'COMMON.DERIV'
5827 include 'COMMON.INTERACT'
5828 include 'COMMON.CONTACTS'
5829 include 'COMMON.TORSION'
5830 include 'COMMON.VAR'
5831 include 'COMMON.GEO'
5832 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5833 double precision ggg1(3),ggg2(3)
5834 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5839 C /l\ / \ \ / \ / \ / C
5840 C / \ / \ \ / \ / \ / C
5841 C j| o |l1 | o | o| o | | o |o C
5842 C \ |/k\| |/ \| / |/ \| |/ \| C
5843 C \i/ \ / \ / / \ / \ C
5845 C (I) (II) (III) (IV) C
5847 C eello5_1 eello5_2 eello5_3 eello5_4 C
5849 C Antiparallel chains C
5852 C /j\ / \ \ / \ / \ / C
5853 C / \ / \ \ / \ / \ / C
5854 C j1| o |l | o | o| o | | o |o C
5855 C \ |/k\| |/ \| / |/ \| |/ \| C
5856 C \i/ \ / \ / / \ / \ C
5858 C (I) (II) (III) (IV) C
5860 C eello5_1 eello5_2 eello5_3 eello5_4 C
5862 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5864 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5865 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5870 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5872 itk=itortyp(itype(k))
5873 itl=itortyp(itype(l))
5874 itj=itortyp(itype(j))
5879 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5880 cd & eel5_3_num,eel5_4_num)
5884 derx(lll,kkk,iii)=0.0d0
5888 cd eij=facont_hb(jj,i)
5889 cd ekl=facont_hb(kk,k)
5891 cd write (iout,*)'Contacts have occurred for peptide groups',
5892 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5894 C Contribution from the graph I.
5895 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5896 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5897 call transpose2(EUg(1,1,k),auxmat(1,1))
5898 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5899 vv(1)=pizda(1,1)-pizda(2,2)
5900 vv(2)=pizda(1,2)+pizda(2,1)
5901 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5902 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5904 C Explicit gradient in virtual-dihedral angles.
5905 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5906 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5907 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5908 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5909 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5910 vv(1)=pizda(1,1)-pizda(2,2)
5911 vv(2)=pizda(1,2)+pizda(2,1)
5912 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5913 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5914 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5915 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5916 vv(1)=pizda(1,1)-pizda(2,2)
5917 vv(2)=pizda(1,2)+pizda(2,1)
5919 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5920 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5921 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5923 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5924 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5925 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5927 C Cartesian gradient
5931 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5933 vv(1)=pizda(1,1)-pizda(2,2)
5934 vv(2)=pizda(1,2)+pizda(2,1)
5935 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5936 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5937 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5944 C Contribution from graph II
5945 call transpose2(EE(1,1,itk),auxmat(1,1))
5946 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5947 vv(1)=pizda(1,1)+pizda(2,2)
5948 vv(2)=pizda(2,1)-pizda(1,2)
5949 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5950 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5952 C Explicit gradient in virtual-dihedral angles.
5953 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5954 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5955 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5956 vv(1)=pizda(1,1)+pizda(2,2)
5957 vv(2)=pizda(2,1)-pizda(1,2)
5959 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5960 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5961 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5963 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5964 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5965 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5967 C Cartesian gradient
5971 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5973 vv(1)=pizda(1,1)+pizda(2,2)
5974 vv(2)=pizda(2,1)-pizda(1,2)
5975 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5976 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5977 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5986 C Parallel orientation
5987 C Contribution from graph III
5988 call transpose2(EUg(1,1,l),auxmat(1,1))
5989 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5990 vv(1)=pizda(1,1)-pizda(2,2)
5991 vv(2)=pizda(1,2)+pizda(2,1)
5992 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5993 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5995 C Explicit gradient in virtual-dihedral angles.
5996 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5997 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5998 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5999 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6000 vv(1)=pizda(1,1)-pizda(2,2)
6001 vv(2)=pizda(1,2)+pizda(2,1)
6002 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6003 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6004 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6005 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6006 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6007 vv(1)=pizda(1,1)-pizda(2,2)
6008 vv(2)=pizda(1,2)+pizda(2,1)
6009 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6010 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6011 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6012 C Cartesian gradient
6016 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6018 vv(1)=pizda(1,1)-pizda(2,2)
6019 vv(2)=pizda(1,2)+pizda(2,1)
6020 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6021 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6022 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6028 C Contribution from graph IV
6030 call transpose2(EE(1,1,itl),auxmat(1,1))
6031 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6032 vv(1)=pizda(1,1)+pizda(2,2)
6033 vv(2)=pizda(2,1)-pizda(1,2)
6034 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6035 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6037 C Explicit gradient in virtual-dihedral angles.
6038 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6039 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6040 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6041 vv(1)=pizda(1,1)+pizda(2,2)
6042 vv(2)=pizda(2,1)-pizda(1,2)
6043 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6044 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6045 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6046 C Cartesian gradient
6050 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6052 vv(1)=pizda(1,1)+pizda(2,2)
6053 vv(2)=pizda(2,1)-pizda(1,2)
6054 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6055 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6056 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6062 C Antiparallel orientation
6063 C Contribution from graph III
6065 call transpose2(EUg(1,1,j),auxmat(1,1))
6066 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6067 vv(1)=pizda(1,1)-pizda(2,2)
6068 vv(2)=pizda(1,2)+pizda(2,1)
6069 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6070 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6072 C Explicit gradient in virtual-dihedral angles.
6073 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6074 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6075 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6076 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6077 vv(1)=pizda(1,1)-pizda(2,2)
6078 vv(2)=pizda(1,2)+pizda(2,1)
6079 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6080 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6081 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6082 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6083 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6084 vv(1)=pizda(1,1)-pizda(2,2)
6085 vv(2)=pizda(1,2)+pizda(2,1)
6086 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6087 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6088 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6089 C Cartesian gradient
6093 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6095 vv(1)=pizda(1,1)-pizda(2,2)
6096 vv(2)=pizda(1,2)+pizda(2,1)
6097 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6098 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6099 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6105 C Contribution from graph IV
6107 call transpose2(EE(1,1,itj),auxmat(1,1))
6108 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6109 vv(1)=pizda(1,1)+pizda(2,2)
6110 vv(2)=pizda(2,1)-pizda(1,2)
6111 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6112 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6114 C Explicit gradient in virtual-dihedral angles.
6115 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6116 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6117 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6118 vv(1)=pizda(1,1)+pizda(2,2)
6119 vv(2)=pizda(2,1)-pizda(1,2)
6120 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6121 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6122 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6123 C Cartesian gradient
6127 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6129 vv(1)=pizda(1,1)+pizda(2,2)
6130 vv(2)=pizda(2,1)-pizda(1,2)
6131 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6132 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6133 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6140 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6141 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6142 cd write (2,*) 'ijkl',i,j,k,l
6143 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6144 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6146 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6147 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6148 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6149 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6151 if (j.lt.nres-1) then
6158 if (l.lt.nres-1) then
6168 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6170 ggg1(ll)=eel5*g_contij(ll,1)
6171 ggg2(ll)=eel5*g_contij(ll,2)
6172 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6173 ghalf=0.5d0*ggg1(ll)
6175 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6176 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6177 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6178 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6179 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6180 ghalf=0.5d0*ggg2(ll)
6182 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6183 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6184 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6185 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6190 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6191 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6196 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6197 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6203 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6208 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6212 cd write (2,*) iii,g_corr5_loc(iii)
6216 cd write (2,*) 'ekont',ekont
6217 cd write (iout,*) 'eello5',ekont*eel5
6220 c--------------------------------------------------------------------------
6221 double precision function eello6(i,j,k,l,jj,kk)
6222 implicit real*8 (a-h,o-z)
6223 include 'DIMENSIONS'
6224 include 'DIMENSIONS.ZSCOPT'
6225 include 'COMMON.IOUNITS'
6226 include 'COMMON.CHAIN'
6227 include 'COMMON.DERIV'
6228 include 'COMMON.INTERACT'
6229 include 'COMMON.CONTACTS'
6230 include 'COMMON.TORSION'
6231 include 'COMMON.VAR'
6232 include 'COMMON.GEO'
6233 include 'COMMON.FFIELD'
6234 double precision ggg1(3),ggg2(3)
6235 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6240 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6248 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6249 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6253 derx(lll,kkk,iii)=0.0d0
6257 cd eij=facont_hb(jj,i)
6258 cd ekl=facont_hb(kk,k)
6264 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6265 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6266 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6267 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6268 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6269 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6271 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6272 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6273 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6274 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6275 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6276 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6280 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6282 C If turn contributions are considered, they will be handled separately.
6283 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6284 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6285 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6286 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6287 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6288 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6289 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6292 if (j.lt.nres-1) then
6299 if (l.lt.nres-1) then
6307 ggg1(ll)=eel6*g_contij(ll,1)
6308 ggg2(ll)=eel6*g_contij(ll,2)
6309 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6310 ghalf=0.5d0*ggg1(ll)
6312 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6313 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6314 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6315 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6316 ghalf=0.5d0*ggg2(ll)
6317 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6319 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6320 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6321 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6322 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6327 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6328 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6333 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6334 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6340 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6345 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6349 cd write (2,*) iii,g_corr6_loc(iii)
6353 cd write (2,*) 'ekont',ekont
6354 cd write (iout,*) 'eello6',ekont*eel6
6357 c--------------------------------------------------------------------------
6358 double precision function eello6_graph1(i,j,k,l,imat,swap)
6359 implicit real*8 (a-h,o-z)
6360 include 'DIMENSIONS'
6361 include 'DIMENSIONS.ZSCOPT'
6362 include 'COMMON.IOUNITS'
6363 include 'COMMON.CHAIN'
6364 include 'COMMON.DERIV'
6365 include 'COMMON.INTERACT'
6366 include 'COMMON.CONTACTS'
6367 include 'COMMON.TORSION'
6368 include 'COMMON.VAR'
6369 include 'COMMON.GEO'
6370 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6374 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6376 C Parallel Antiparallel C
6382 C \ j|/k\| / \ |/k\|l / C
6387 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6388 itk=itortyp(itype(k))
6389 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6390 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6391 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6392 call transpose2(EUgC(1,1,k),auxmat(1,1))
6393 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6394 vv1(1)=pizda1(1,1)-pizda1(2,2)
6395 vv1(2)=pizda1(1,2)+pizda1(2,1)
6396 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6397 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6398 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6399 s5=scalar2(vv(1),Dtobr2(1,i))
6400 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6401 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6402 if (.not. calc_grad) return
6403 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6404 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6405 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6406 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6407 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6408 & +scalar2(vv(1),Dtobr2der(1,i)))
6409 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6410 vv1(1)=pizda1(1,1)-pizda1(2,2)
6411 vv1(2)=pizda1(1,2)+pizda1(2,1)
6412 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6413 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6415 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6416 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6417 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6418 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6419 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6421 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6422 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6423 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6424 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6425 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6427 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6428 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6429 vv1(1)=pizda1(1,1)-pizda1(2,2)
6430 vv1(2)=pizda1(1,2)+pizda1(2,1)
6431 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6432 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6433 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6434 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6443 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6444 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6445 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6446 call transpose2(EUgC(1,1,k),auxmat(1,1))
6447 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6449 vv1(1)=pizda1(1,1)-pizda1(2,2)
6450 vv1(2)=pizda1(1,2)+pizda1(2,1)
6451 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6452 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6453 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6454 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6455 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6456 s5=scalar2(vv(1),Dtobr2(1,i))
6457 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6463 c----------------------------------------------------------------------------
6464 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6465 implicit real*8 (a-h,o-z)
6466 include 'DIMENSIONS'
6467 include 'DIMENSIONS.ZSCOPT'
6468 include 'COMMON.IOUNITS'
6469 include 'COMMON.CHAIN'
6470 include 'COMMON.DERIV'
6471 include 'COMMON.INTERACT'
6472 include 'COMMON.CONTACTS'
6473 include 'COMMON.TORSION'
6474 include 'COMMON.VAR'
6475 include 'COMMON.GEO'
6477 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6478 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6481 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6483 C Parallel Antiparallel C
6489 C \ j|/k\| \ |/k\|l C
6494 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6495 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6496 C AL 7/4/01 s1 would occur in the sixth-order moment,
6497 C but not in a cluster cumulant
6499 s1=dip(1,jj,i)*dip(1,kk,k)
6501 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6502 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6503 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6504 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6505 call transpose2(EUg(1,1,k),auxmat(1,1))
6506 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6507 vv(1)=pizda(1,1)-pizda(2,2)
6508 vv(2)=pizda(1,2)+pizda(2,1)
6509 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6510 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6512 eello6_graph2=-(s1+s2+s3+s4)
6514 eello6_graph2=-(s2+s3+s4)
6517 if (.not. calc_grad) return
6518 C Derivatives in gamma(i-1)
6521 s1=dipderg(1,jj,i)*dip(1,kk,k)
6523 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6524 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6525 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6526 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6528 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6530 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6532 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6534 C Derivatives in gamma(k-1)
6536 s1=dip(1,jj,i)*dipderg(1,kk,k)
6538 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6539 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6540 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6541 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6542 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6543 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6544 vv(1)=pizda(1,1)-pizda(2,2)
6545 vv(2)=pizda(1,2)+pizda(2,1)
6546 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6548 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6550 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6552 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6553 C Derivatives in gamma(j-1) or gamma(l-1)
6556 s1=dipderg(3,jj,i)*dip(1,kk,k)
6558 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6559 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6560 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6561 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6562 vv(1)=pizda(1,1)-pizda(2,2)
6563 vv(2)=pizda(1,2)+pizda(2,1)
6564 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6567 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6569 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6572 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6573 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6575 C Derivatives in gamma(l-1) or gamma(j-1)
6578 s1=dip(1,jj,i)*dipderg(3,kk,k)
6580 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6581 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6582 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6583 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6584 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6585 vv(1)=pizda(1,1)-pizda(2,2)
6586 vv(2)=pizda(1,2)+pizda(2,1)
6587 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6590 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6592 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6595 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6596 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6598 C Cartesian derivatives.
6600 write (2,*) 'In eello6_graph2'
6602 write (2,*) 'iii=',iii
6604 write (2,*) 'kkk=',kkk
6606 write (2,'(3(2f10.5),5x)')
6607 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6617 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6619 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6622 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6624 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6625 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6627 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6628 call transpose2(EUg(1,1,k),auxmat(1,1))
6629 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(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))
6634 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6636 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6638 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6641 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6643 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6650 c----------------------------------------------------------------------------
6651 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6652 implicit real*8 (a-h,o-z)
6653 include 'DIMENSIONS'
6654 include 'DIMENSIONS.ZSCOPT'
6655 include 'COMMON.IOUNITS'
6656 include 'COMMON.CHAIN'
6657 include 'COMMON.DERIV'
6658 include 'COMMON.INTERACT'
6659 include 'COMMON.CONTACTS'
6660 include 'COMMON.TORSION'
6661 include 'COMMON.VAR'
6662 include 'COMMON.GEO'
6663 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6665 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6667 C Parallel Antiparallel C
6673 C j|/k\| / |/k\|l / C
6678 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6680 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6681 C energy moment and not to the cluster cumulant.
6682 iti=itortyp(itype(i))
6683 if (j.lt.nres-1) then
6684 itj1=itortyp(itype(j+1))
6688 itk=itortyp(itype(k))
6689 itk1=itortyp(itype(k+1))
6690 if (l.lt.nres-1) then
6691 itl1=itortyp(itype(l+1))
6696 s1=dip(4,jj,i)*dip(4,kk,k)
6698 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6699 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6700 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6701 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6702 call transpose2(EE(1,1,itk),auxmat(1,1))
6703 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6704 vv(1)=pizda(1,1)+pizda(2,2)
6705 vv(2)=pizda(2,1)-pizda(1,2)
6706 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6707 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6709 eello6_graph3=-(s1+s2+s3+s4)
6711 eello6_graph3=-(s2+s3+s4)
6714 if (.not. calc_grad) return
6715 C Derivatives in gamma(k-1)
6716 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6717 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6718 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6719 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6720 C Derivatives in gamma(l-1)
6721 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6722 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6723 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6724 vv(1)=pizda(1,1)+pizda(2,2)
6725 vv(2)=pizda(2,1)-pizda(1,2)
6726 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6727 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6728 C Cartesian derivatives.
6734 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6736 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6739 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6741 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6742 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6744 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6745 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6747 vv(1)=pizda(1,1)+pizda(2,2)
6748 vv(2)=pizda(2,1)-pizda(1,2)
6749 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6751 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6753 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6756 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6758 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6760 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6766 c----------------------------------------------------------------------------
6767 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6768 implicit real*8 (a-h,o-z)
6769 include 'DIMENSIONS'
6770 include 'DIMENSIONS.ZSCOPT'
6771 include 'COMMON.IOUNITS'
6772 include 'COMMON.CHAIN'
6773 include 'COMMON.DERIV'
6774 include 'COMMON.INTERACT'
6775 include 'COMMON.CONTACTS'
6776 include 'COMMON.TORSION'
6777 include 'COMMON.VAR'
6778 include 'COMMON.GEO'
6779 include 'COMMON.FFIELD'
6780 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6781 & auxvec1(2),auxmat1(2,2)
6783 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6785 C Parallel Antiparallel C
6791 C \ j|/k\| \ |/k\|l C
6796 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6798 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6799 C energy moment and not to the cluster cumulant.
6800 cd write (2,*) 'eello_graph4: wturn6',wturn6
6801 iti=itortyp(itype(i))
6802 itj=itortyp(itype(j))
6803 if (j.lt.nres-1) then
6804 itj1=itortyp(itype(j+1))
6808 itk=itortyp(itype(k))
6809 if (k.lt.nres-1) then
6810 itk1=itortyp(itype(k+1))
6814 itl=itortyp(itype(l))
6815 if (l.lt.nres-1) then
6816 itl1=itortyp(itype(l+1))
6820 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6821 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6822 cd & ' itl',itl,' itl1',itl1
6825 s1=dip(3,jj,i)*dip(3,kk,k)
6827 s1=dip(2,jj,j)*dip(2,kk,l)
6830 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6831 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6833 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6834 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6836 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6837 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6839 call transpose2(EUg(1,1,k),auxmat(1,1))
6840 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6841 vv(1)=pizda(1,1)-pizda(2,2)
6842 vv(2)=pizda(2,1)+pizda(1,2)
6843 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6844 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6846 eello6_graph4=-(s1+s2+s3+s4)
6848 eello6_graph4=-(s2+s3+s4)
6850 if (.not. calc_grad) return
6851 C Derivatives in gamma(i-1)
6855 s1=dipderg(2,jj,i)*dip(3,kk,k)
6857 s1=dipderg(4,jj,j)*dip(2,kk,l)
6860 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6862 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6863 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6865 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6866 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6868 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6869 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6870 cd write (2,*) 'turn6 derivatives'
6872 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6874 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6878 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6880 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6884 C Derivatives in gamma(k-1)
6887 s1=dip(3,jj,i)*dipderg(2,kk,k)
6889 s1=dip(2,jj,j)*dipderg(4,kk,l)
6892 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6893 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6895 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6896 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6898 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6899 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6901 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6902 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6903 vv(1)=pizda(1,1)-pizda(2,2)
6904 vv(2)=pizda(2,1)+pizda(1,2)
6905 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6906 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6908 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6910 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6914 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6916 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6919 C Derivatives in gamma(j-1) or gamma(l-1)
6920 if (l.eq.j+1 .and. l.gt.1) then
6921 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6922 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6923 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6924 vv(1)=pizda(1,1)-pizda(2,2)
6925 vv(2)=pizda(2,1)+pizda(1,2)
6926 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6927 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6928 else if (j.gt.1) then
6929 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6930 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6931 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6932 vv(1)=pizda(1,1)-pizda(2,2)
6933 vv(2)=pizda(2,1)+pizda(1,2)
6934 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6935 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6936 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6938 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6941 C Cartesian derivatives.
6948 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6950 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6954 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6956 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6960 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6962 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6964 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6965 & b1(1,itj1),auxvec(1))
6966 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6968 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6969 & b1(1,itl1),auxvec(1))
6970 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6972 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6974 vv(1)=pizda(1,1)-pizda(2,2)
6975 vv(2)=pizda(2,1)+pizda(1,2)
6976 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6978 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6980 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6983 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6986 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6989 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6991 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6993 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6997 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6999 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7002 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7004 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7012 c----------------------------------------------------------------------------
7013 double precision function eello_turn6(i,jj,kk)
7014 implicit real*8 (a-h,o-z)
7015 include 'DIMENSIONS'
7016 include 'DIMENSIONS.ZSCOPT'
7017 include 'COMMON.IOUNITS'
7018 include 'COMMON.CHAIN'
7019 include 'COMMON.DERIV'
7020 include 'COMMON.INTERACT'
7021 include 'COMMON.CONTACTS'
7022 include 'COMMON.TORSION'
7023 include 'COMMON.VAR'
7024 include 'COMMON.GEO'
7025 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7026 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7028 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7029 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7030 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7031 C the respective energy moment and not to the cluster cumulant.
7036 iti=itortyp(itype(i))
7037 itk=itortyp(itype(k))
7038 itk1=itortyp(itype(k+1))
7039 itl=itortyp(itype(l))
7040 itj=itortyp(itype(j))
7041 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7042 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7043 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7048 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7050 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7054 derx_turn(lll,kkk,iii)=0.0d0
7061 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7063 cd write (2,*) 'eello6_5',eello6_5
7065 call transpose2(AEA(1,1,1),auxmat(1,1))
7066 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7067 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7068 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7072 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7073 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7074 s2 = scalar2(b1(1,itk),vtemp1(1))
7076 call transpose2(AEA(1,1,2),atemp(1,1))
7077 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7078 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7079 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7083 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7084 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7085 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7087 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7088 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7089 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7090 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7091 ss13 = scalar2(b1(1,itk),vtemp4(1))
7092 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7096 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7102 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7104 C Derivatives in gamma(i+2)
7106 call transpose2(AEA(1,1,1),auxmatd(1,1))
7107 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7108 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7109 call transpose2(AEAderg(1,1,2),atempd(1,1))
7110 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7111 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7115 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7116 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7117 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7123 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7124 C Derivatives in gamma(i+3)
7126 call transpose2(AEA(1,1,1),auxmatd(1,1))
7127 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7128 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7129 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7133 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7134 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7135 s2d = scalar2(b1(1,itk),vtemp1d(1))
7137 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7138 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7140 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7142 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7143 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7144 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7154 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7155 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7157 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7158 & -0.5d0*ekont*(s2d+s12d)
7160 C Derivatives in gamma(i+4)
7161 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7162 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7163 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7165 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7166 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7167 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7177 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7179 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7181 C Derivatives in gamma(i+5)
7183 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7184 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7185 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7189 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7190 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7191 s2d = scalar2(b1(1,itk),vtemp1d(1))
7193 call transpose2(AEA(1,1,2),atempd(1,1))
7194 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7195 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7199 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7200 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7202 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7203 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7204 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7214 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7215 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7217 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7218 & -0.5d0*ekont*(s2d+s12d)
7220 C Cartesian derivatives
7225 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7226 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7227 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7231 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7232 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7234 s2d = scalar2(b1(1,itk),vtemp1d(1))
7236 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7237 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7238 s8d = -(atempd(1,1)+atempd(2,2))*
7239 & scalar2(cc(1,1,itl),vtemp2(1))
7243 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7245 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7246 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7253 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7256 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7260 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7261 & - 0.5d0*(s8d+s12d)
7263 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7272 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7274 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7275 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7276 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7277 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7278 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7280 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7281 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7282 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7286 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7287 cd & 16*eel_turn6_num
7289 if (j.lt.nres-1) then
7296 if (l.lt.nres-1) then
7304 ggg1(ll)=eel_turn6*g_contij(ll,1)
7305 ggg2(ll)=eel_turn6*g_contij(ll,2)
7306 ghalf=0.5d0*ggg1(ll)
7308 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7309 & +ekont*derx_turn(ll,2,1)
7310 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7311 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7312 & +ekont*derx_turn(ll,4,1)
7313 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7314 ghalf=0.5d0*ggg2(ll)
7316 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7317 & +ekont*derx_turn(ll,2,2)
7318 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7319 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7320 & +ekont*derx_turn(ll,4,2)
7321 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7326 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7331 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7337 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7342 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7346 cd write (2,*) iii,g_corr6_loc(iii)
7349 eello_turn6=ekont*eel_turn6
7350 cd write (2,*) 'ekont',ekont
7351 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7354 crc-------------------------------------------------
7355 SUBROUTINE MATVEC2(A1,V1,V2)
7356 implicit real*8 (a-h,o-z)
7357 include 'DIMENSIONS'
7358 DIMENSION A1(2,2),V1(2),V2(2)
7362 c 3 VI=VI+A1(I,K)*V1(K)
7366 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7367 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7372 C---------------------------------------
7373 SUBROUTINE MATMAT2(A1,A2,A3)
7374 implicit real*8 (a-h,o-z)
7375 include 'DIMENSIONS'
7376 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7377 c DIMENSION AI3(2,2)
7381 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7387 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7388 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7389 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7390 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7398 c-------------------------------------------------------------------------
7399 double precision function scalar2(u,v)
7401 double precision u(2),v(2)
7404 scalar2=u(1)*v(1)+u(2)*v(2)
7408 C-----------------------------------------------------------------------------
7410 subroutine transpose2(a,at)
7412 double precision a(2,2),at(2,2)
7419 c--------------------------------------------------------------------------
7420 subroutine transpose(n,a,at)
7423 double precision a(n,n),at(n,n)
7431 C---------------------------------------------------------------------------
7432 subroutine prodmat3(a1,a2,kk,transp,prod)
7435 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7437 crc double precision auxmat(2,2),prod_(2,2)
7440 crc call transpose2(kk(1,1),auxmat(1,1))
7441 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7442 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7444 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7445 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7446 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7447 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7448 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7449 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7450 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7451 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7454 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7455 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7457 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7458 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7459 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7460 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7461 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7462 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7463 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7464 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7467 c call transpose2(a2(1,1),a2t(1,1))
7470 crc print *,((prod_(i,j),i=1,2),j=1,2)
7471 crc print *,((prod(i,j),i=1,2),j=1,2)
7475 C-----------------------------------------------------------------------------
7476 double precision function scalar(u,v)
7478 double precision u(3),v(3)