1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
160 if (isnan(etot).ne.0) energia(0)=1.0d+99
162 if (isnan(etot)) energia(0)=1.0d+99
167 idumm=proc_proc(etot,i)
169 call proc_proc(etot,i)
171 if(i.eq.1)energia(0)=1.0d+99
178 C Sum up the components of the Cartesian gradient.
183 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
184 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
186 & wstrain*ghpbc(j,i)+
187 & wcorr*fact(3)*gradcorr(j,i)+
188 & wel_loc*fact(2)*gel_loc(j,i)+
189 & wturn3*fact(2)*gcorr3_turn(j,i)+
190 & wturn4*fact(3)*gcorr4_turn(j,i)+
191 & wcorr5*fact(4)*gradcorr5(j,i)+
192 & wcorr6*fact(5)*gradcorr6(j,i)+
193 & wturn6*fact(5)*gcorr6_turn(j,i)+
194 & wsccor*fact(2)*gsccorc(j,i)
195 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
197 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
198 & wsccor*fact(2)*gsccorx(j,i)
203 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
204 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
206 & wcorr*fact(3)*gradcorr(j,i)+
207 & wel_loc*fact(2)*gel_loc(j,i)+
208 & wturn3*fact(2)*gcorr3_turn(j,i)+
209 & wturn4*fact(3)*gcorr4_turn(j,i)+
210 & wcorr5*fact(4)*gradcorr5(j,i)+
211 & wcorr6*fact(5)*gradcorr6(j,i)+
212 & wturn6*fact(5)*gcorr6_turn(j,i)+
213 & wsccor*fact(2)*gsccorc(j,i)
214 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
216 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
217 & wsccor*fact(1)*gsccorx(j,i)
224 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
225 & +wcorr5*fact(4)*g_corr5_loc(i)
226 & +wcorr6*fact(5)*g_corr6_loc(i)
227 & +wturn4*fact(3)*gel_loc_turn4(i)
228 & +wturn3*fact(2)*gel_loc_turn3(i)
229 & +wturn6*fact(5)*gel_loc_turn6(i)
230 & +wel_loc*fact(2)*gel_loc_loc(i)
231 & +wsccor*fact(1)*gsccor_loc(i)
236 C------------------------------------------------------------------------
237 subroutine enerprint(energia,fact)
238 implicit real*8 (a-h,o-z)
240 include 'DIMENSIONS.ZSCOPT'
241 include 'COMMON.IOUNITS'
242 include 'COMMON.FFIELD'
243 include 'COMMON.SBRIDGE'
244 double precision energia(0:max_ene),fact(6)
246 evdw=energia(1)+fact(6)*energia(21)
248 evdw2=energia(2)+energia(17)
260 eello_turn3=energia(8)
261 eello_turn4=energia(9)
262 eello_turn6=energia(10)
269 edihcnstr=energia(20)
272 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
274 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
275 & etors_d,wtor_d*fact(2),ehpb,wstrain,
276 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
277 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
278 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
279 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
280 10 format (/'Virtual-chain energies:'//
281 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
282 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
283 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
284 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
285 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
286 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
287 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
288 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
289 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
290 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
291 & ' (SS bridges & dist. cnstr.)'/
292 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
293 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
296 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
297 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
298 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
299 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
300 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
301 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
302 & 'ETOT= ',1pE16.6,' (total)')
304 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
305 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
306 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
307 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
308 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
309 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
310 & edihcnstr,ebr*nss,etot
311 10 format (/'Virtual-chain energies:'//
312 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
313 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
314 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
315 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
316 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
317 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
318 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
319 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
320 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
321 & ' (SS bridges & dist. cnstr.)'/
322 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
323 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
326 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
327 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
328 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
329 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
330 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
331 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
332 & 'ETOT= ',1pE16.6,' (total)')
336 C-----------------------------------------------------------------------
337 subroutine elj(evdw,evdw_t)
339 C This subroutine calculates the interaction energy of nonbonded side chains
340 C assuming the LJ potential of interaction.
342 implicit real*8 (a-h,o-z)
344 include 'DIMENSIONS.ZSCOPT'
345 include "DIMENSIONS.COMPAR"
346 parameter (accur=1.0d-10)
349 include 'COMMON.LOCAL'
350 include 'COMMON.CHAIN'
351 include 'COMMON.DERIV'
352 include 'COMMON.INTERACT'
353 include 'COMMON.TORSION'
354 include 'COMMON.ENEPS'
355 include 'COMMON.SBRIDGE'
356 include 'COMMON.NAMES'
357 include 'COMMON.IOUNITS'
358 include 'COMMON.CONTACTS'
362 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
365 eneps_temp(j,i)=0.0d0
372 if (itypi.eq.21) cycle
373 itypi1=iabs(itype(i+1))
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)
387 if (itypj.eq.21) cycle
391 C Change 12/1/95 to calculate four-body interactions
392 rij=xj*xj+yj*yj+zj*zj
394 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
395 eps0ij=eps(itypi,itypj)
397 e1=fac*fac*aa(itypi,itypj)
398 e2=fac*bb(itypi,itypj)
400 ij=icant(itypi,itypj)
401 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
402 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
403 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
404 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
405 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
406 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
407 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
408 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
409 if (bb(itypi,itypj).gt.0.0d0) then
416 C Calculate the components of the gradient in DC and X
418 fac=-rrij*(e1+evdwij)
423 gvdwx(k,i)=gvdwx(k,i)-gg(k)
424 gvdwx(k,j)=gvdwx(k,j)+gg(k)
428 gvdwc(l,k)=gvdwc(l,k)+gg(l)
433 C 12/1/95, revised on 5/20/97
435 C Calculate the contact function. The ith column of the array JCONT will
436 C contain the numbers of atoms that make contacts with the atom I (of numbers
437 C greater than I). The arrays FACONT and GACONT will contain the values of
438 C the contact function and its derivative.
440 C Uncomment next line, if the correlation interactions include EVDW explicitly.
441 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
442 C Uncomment next line, if the correlation interactions are contact function only
443 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
445 sigij=sigma(itypi,itypj)
446 r0ij=rs0(itypi,itypj)
448 C Check whether the SC's are not too far to make a contact.
451 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
452 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
454 if (fcont.gt.0.0D0) then
455 C If the SC-SC distance if close to sigma, apply spline.
456 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
457 cAdam & fcont1,fprimcont1)
458 cAdam fcont1=1.0d0-fcont1
459 cAdam if (fcont1.gt.0.0d0) then
460 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
461 cAdam fcont=fcont*fcont1
463 C Uncomment following 4 lines to have the geometric average of the epsilon0's
464 cga eps0ij=1.0d0/dsqrt(eps0ij)
466 cga gg(k)=gg(k)*eps0ij
468 cga eps0ij=-evdwij*eps0ij
469 C Uncomment for AL's type of SC correlation interactions.
471 num_conti=num_conti+1
473 facont(num_conti,i)=fcont*eps0ij
474 fprimcont=eps0ij*fprimcont/rij
476 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
477 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
478 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
479 C Uncomment following 3 lines for Skolnick's type of SC correlation.
480 gacont(1,num_conti,i)=-fprimcont*xj
481 gacont(2,num_conti,i)=-fprimcont*yj
482 gacont(3,num_conti,i)=-fprimcont*zj
483 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
484 cd write (iout,'(2i3,3f10.5)')
485 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
491 num_cont(i)=num_conti
496 gvdwc(j,i)=expon*gvdwc(j,i)
497 gvdwx(j,i)=expon*gvdwx(j,i)
501 C******************************************************************************
505 C To save time, the factor of EXPON has been extracted from ALL components
506 C of GVDWC and GRADX. Remember to multiply them by this factor before further
509 C******************************************************************************
512 C-----------------------------------------------------------------------------
513 subroutine eljk(evdw,evdw_t)
515 C This subroutine calculates the interaction energy of nonbonded side chains
516 C assuming the LJK potential of interaction.
518 implicit real*8 (a-h,o-z)
520 include 'DIMENSIONS.ZSCOPT'
521 include "DIMENSIONS.COMPAR"
524 include 'COMMON.LOCAL'
525 include 'COMMON.CHAIN'
526 include 'COMMON.DERIV'
527 include 'COMMON.INTERACT'
528 include 'COMMON.ENEPS'
529 include 'COMMON.IOUNITS'
530 include 'COMMON.NAMES'
535 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
538 eneps_temp(j,i)=0.0d0
545 if (itypi.eq.21) cycle
546 itypi1=iabs(itype(i+1))
551 C Calculate SC interaction energy.
554 do j=istart(i,iint),iend(i,iint)
556 if (itypj.eq.21) cycle
560 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
562 e_augm=augm(itypi,itypj)*fac_augm
565 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
566 fac=r_shift_inv**expon
567 e1=fac*fac*aa(itypi,itypj)
568 e2=fac*bb(itypi,itypj)
570 ij=icant(itypi,itypj)
571 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
572 & /dabs(eps(itypi,itypj))
573 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
574 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
575 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
576 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
577 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
578 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
579 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
580 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
581 if (bb(itypi,itypj).gt.0.0d0) then
588 C Calculate the components of the gradient in DC and X
590 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
595 gvdwx(k,i)=gvdwx(k,i)-gg(k)
596 gvdwx(k,j)=gvdwx(k,j)+gg(k)
600 gvdwc(l,k)=gvdwc(l,k)+gg(l)
610 gvdwc(j,i)=expon*gvdwc(j,i)
611 gvdwx(j,i)=expon*gvdwx(j,i)
617 C-----------------------------------------------------------------------------
618 subroutine ebp(evdw,evdw_t)
620 C This subroutine calculates the interaction energy of nonbonded side chains
621 C assuming the Berne-Pechukas potential of interaction.
623 implicit real*8 (a-h,o-z)
625 include 'DIMENSIONS.ZSCOPT'
626 include "DIMENSIONS.COMPAR"
629 include 'COMMON.LOCAL'
630 include 'COMMON.CHAIN'
631 include 'COMMON.DERIV'
632 include 'COMMON.NAMES'
633 include 'COMMON.INTERACT'
634 include 'COMMON.ENEPS'
635 include 'COMMON.IOUNITS'
636 include 'COMMON.CALC'
638 c double precision rrsave(maxdim)
644 eneps_temp(j,i)=0.0d0
649 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
650 c if (icall.eq.0) then
658 if (itypi.eq.21) cycle
659 itypi1=iabs(itype(i+1))
663 dxi=dc_norm(1,nres+i)
664 dyi=dc_norm(2,nres+i)
665 dzi=dc_norm(3,nres+i)
666 dsci_inv=vbld_inv(i+nres)
668 C Calculate SC interaction energy.
671 do j=istart(i,iint),iend(i,iint)
674 if (itypj.eq.21) cycle
675 dscj_inv=vbld_inv(j+nres)
676 chi1=chi(itypi,itypj)
677 chi2=chi(itypj,itypi)
684 alf12=0.5D0*(alf1+alf2)
685 C For diagnostics only!!!
698 dxj=dc_norm(1,nres+j)
699 dyj=dc_norm(2,nres+j)
700 dzj=dc_norm(3,nres+j)
701 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
702 cd if (icall.eq.0) then
708 C Calculate the angle-dependent terms of energy & contributions to derivatives.
710 C Calculate whole angle-dependent part of epsilon and contributions
712 fac=(rrij*sigsq)**expon2
713 e1=fac*fac*aa(itypi,itypj)
714 e2=fac*bb(itypi,itypj)
715 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
716 eps2der=evdwij*eps3rt
717 eps3der=evdwij*eps2rt
718 evdwij=evdwij*eps2rt*eps3rt
719 ij=icant(itypi,itypj)
720 aux=eps1*eps2rt**2*eps3rt**2
721 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
722 & /dabs(eps(itypi,itypj))
723 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
724 if (bb(itypi,itypj).gt.0.0d0) then
731 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
732 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
733 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
734 & restyp(itypi),i,restyp(itypj),j,
735 & epsi,sigm,chi1,chi2,chip1,chip2,
736 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
737 & om1,om2,om12,1.0D0/dsqrt(rrij),
740 C Calculate gradient components.
741 e1=e1*eps1*eps2rt**2*eps3rt**2
742 fac=-expon*(e1+evdwij)
745 C Calculate radial part of the gradient
749 C Calculate the angular part of the gradient and sum add the contributions
750 C to the appropriate components of the Cartesian gradient.
759 C-----------------------------------------------------------------------------
760 subroutine egb(evdw,evdw_t)
762 C This subroutine calculates the interaction energy of nonbonded side chains
763 C assuming the Gay-Berne potential of interaction.
765 implicit real*8 (a-h,o-z)
767 include 'DIMENSIONS.ZSCOPT'
768 include "DIMENSIONS.COMPAR"
771 include 'COMMON.LOCAL'
772 include 'COMMON.CHAIN'
773 include 'COMMON.DERIV'
774 include 'COMMON.NAMES'
775 include 'COMMON.INTERACT'
776 include 'COMMON.ENEPS'
777 include 'COMMON.IOUNITS'
778 include 'COMMON.CALC'
785 eneps_temp(j,i)=0.0d0
788 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
792 c if (icall.gt.0) lprn=.true.
796 if (itypi.eq.21) cycle
797 itypi1=iabs(itype(i+1))
801 dxi=dc_norm(1,nres+i)
802 dyi=dc_norm(2,nres+i)
803 dzi=dc_norm(3,nres+i)
804 dsci_inv=vbld_inv(i+nres)
806 C Calculate SC interaction energy.
809 do j=istart(i,iint),iend(i,iint)
812 if (itypj.eq.21) cycle
813 dscj_inv=vbld_inv(j+nres)
814 sig0ij=sigma(itypi,itypj)
815 chi1=chi(itypi,itypj)
816 chi2=chi(itypj,itypi)
823 alf12=0.5D0*(alf1+alf2)
824 C For diagnostics only!!!
837 dxj=dc_norm(1,nres+j)
838 dyj=dc_norm(2,nres+j)
839 dzj=dc_norm(3,nres+j)
840 c write (iout,*) i,j,xj,yj,zj
841 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
843 C Calculate angle-dependent terms of energy and contributions to their
847 sig=sig0ij*dsqrt(sigsq)
848 rij_shift=1.0D0/rij-sig+sig0ij
849 C I hate to put IF's in the loops, but here don't have another choice!!!!
850 if (rij_shift.le.0.0D0) then
855 c---------------------------------------------------------------
856 rij_shift=1.0D0/rij_shift
858 e1=fac*fac*aa(itypi,itypj)
859 e2=fac*bb(itypi,itypj)
860 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
861 eps2der=evdwij*eps3rt
862 eps3der=evdwij*eps2rt
863 evdwij=evdwij*eps2rt*eps3rt
864 if (bb(itypi,itypj).gt.0) then
869 ij=icant(itypi,itypj)
870 aux=eps1*eps2rt**2*eps3rt**2
871 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
872 & /dabs(eps(itypi,itypj))
873 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
874 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
875 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
876 c & aux*e2/eps(itypi,itypj)
878 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
879 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
881 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
882 & restyp(itypi),i,restyp(itypj),j,
883 & epsi,sigm,chi1,chi2,chip1,chip2,
884 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
885 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
887 write (iout,*) "partial sum", evdw, evdw_t
891 C Calculate gradient components.
892 e1=e1*eps1*eps2rt**2*eps3rt**2
893 fac=-expon*(e1+evdwij)*rij_shift
896 C Calculate the radial part of the gradient
900 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.
946 if (itypi.eq.21) cycle
947 itypi1=iabs(itype(i+1))
951 dxi=dc_norm(1,nres+i)
952 dyi=dc_norm(2,nres+i)
953 dzi=dc_norm(3,nres+i)
954 dsci_inv=vbld_inv(i+nres)
956 C Calculate SC interaction energy.
959 do j=istart(i,iint),iend(i,iint)
962 if (itypj.eq.21) cycle
963 dscj_inv=vbld_inv(j+nres)
964 sig0ij=sigma(itypi,itypj)
966 chi1=chi(itypi,itypj)
967 chi2=chi(itypj,itypi)
974 alf12=0.5D0*(alf1+alf2)
975 C For diagnostics only!!!
988 dxj=dc_norm(1,nres+j)
989 dyj=dc_norm(2,nres+j)
990 dzj=dc_norm(3,nres+j)
991 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
993 C Calculate angle-dependent terms of energy and contributions to their
997 sig=sig0ij*dsqrt(sigsq)
998 rij_shift=1.0D0/rij-sig+r0ij
999 C I hate to put IF's in the loops, but here don't have another choice!!!!
1000 if (rij_shift.le.0.0D0) then
1005 c---------------------------------------------------------------
1006 rij_shift=1.0D0/rij_shift
1007 fac=rij_shift**expon
1008 e1=fac*fac*aa(itypi,itypj)
1009 e2=fac*bb(itypi,itypj)
1010 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1011 eps2der=evdwij*eps3rt
1012 eps3der=evdwij*eps2rt
1013 fac_augm=rrij**expon
1014 e_augm=augm(itypi,itypj)*fac_augm
1015 evdwij=evdwij*eps2rt*eps3rt
1016 if (bb(itypi,itypj).gt.0.0d0) then
1017 evdw=evdw+evdwij+e_augm
1019 evdw_t=evdw_t+evdwij+e_augm
1021 ij=icant(itypi,itypj)
1022 aux=eps1*eps2rt**2*eps3rt**2
1023 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1024 & /dabs(eps(itypi,itypj))
1025 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1026 c eneps_temp(ij)=eneps_temp(ij)
1027 c & +(evdwij+e_augm)/eps(itypi,itypj)
1029 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1030 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1031 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1032 c & restyp(itypi),i,restyp(itypj),j,
1033 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1034 c & chi1,chi2,chip1,chip2,
1035 c & eps1,eps2rt**2,eps3rt**2,
1036 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1040 C Calculate gradient components.
1041 e1=e1*eps1*eps2rt**2*eps3rt**2
1042 fac=-expon*(e1+evdwij)*rij_shift
1044 fac=rij*fac-2*expon*rrij*e_augm
1045 C Calculate the radial part of the gradient
1049 C Calculate angular part of the gradient.
1057 C-----------------------------------------------------------------------------
1058 subroutine sc_angular
1059 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1060 C om12. Called by ebp, egb, and egbv.
1062 include 'COMMON.CALC'
1066 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1067 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1068 om12=dxi*dxj+dyi*dyj+dzi*dzj
1070 C Calculate eps1(om12) and its derivative in om12
1071 faceps1=1.0D0-om12*chiom12
1072 faceps1_inv=1.0D0/faceps1
1073 eps1=dsqrt(faceps1_inv)
1074 C Following variable is eps1*deps1/dom12
1075 eps1_om12=faceps1_inv*chiom12
1076 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1081 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1082 sigsq=1.0D0-facsig*faceps1_inv
1083 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1084 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1085 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1086 C Calculate eps2 and its derivatives in om1, om2, and om12.
1089 chipom12=chip12*om12
1090 facp=1.0D0-om12*chipom12
1092 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1093 C Following variable is the square root of eps2
1094 eps2rt=1.0D0-facp1*facp_inv
1095 C Following three variables are the derivatives of the square root of eps
1096 C in om1, om2, and om12.
1097 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1098 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1099 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1100 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1101 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1102 C Calculate whole angle-dependent part of epsilon and contributions
1103 C to its derivatives
1106 C----------------------------------------------------------------------------
1108 implicit real*8 (a-h,o-z)
1109 include 'DIMENSIONS'
1110 include 'DIMENSIONS.ZSCOPT'
1111 include 'COMMON.CHAIN'
1112 include 'COMMON.DERIV'
1113 include 'COMMON.CALC'
1114 double precision dcosom1(3),dcosom2(3)
1115 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1116 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1117 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1118 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1120 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1121 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1124 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1127 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1128 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1129 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1130 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1131 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1132 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1135 C Calculate the components of the gradient in DC and X
1139 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1144 c------------------------------------------------------------------------------
1145 subroutine vec_and_deriv
1146 implicit real*8 (a-h,o-z)
1147 include 'DIMENSIONS'
1148 include 'DIMENSIONS.ZSCOPT'
1149 include 'COMMON.IOUNITS'
1150 include 'COMMON.GEO'
1151 include 'COMMON.VAR'
1152 include 'COMMON.LOCAL'
1153 include 'COMMON.CHAIN'
1154 include 'COMMON.VECTORS'
1155 include 'COMMON.DERIV'
1156 include 'COMMON.INTERACT'
1157 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1158 C Compute the local reference systems. For reference system (i), the
1159 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1160 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1162 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1163 if (i.eq.nres-1) then
1164 C Case of the last full residue
1165 C Compute the Z-axis
1166 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1167 costh=dcos(pi-theta(nres))
1168 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1173 C Compute the derivatives of uz
1175 uzder(2,1,1)=-dc_norm(3,i-1)
1176 uzder(3,1,1)= dc_norm(2,i-1)
1177 uzder(1,2,1)= dc_norm(3,i-1)
1179 uzder(3,2,1)=-dc_norm(1,i-1)
1180 uzder(1,3,1)=-dc_norm(2,i-1)
1181 uzder(2,3,1)= dc_norm(1,i-1)
1184 uzder(2,1,2)= dc_norm(3,i)
1185 uzder(3,1,2)=-dc_norm(2,i)
1186 uzder(1,2,2)=-dc_norm(3,i)
1188 uzder(3,2,2)= dc_norm(1,i)
1189 uzder(1,3,2)= dc_norm(2,i)
1190 uzder(2,3,2)=-dc_norm(1,i)
1193 C Compute the Y-axis
1196 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1199 C Compute the derivatives of uy
1202 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1203 & -dc_norm(k,i)*dc_norm(j,i-1)
1204 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1206 uyder(j,j,1)=uyder(j,j,1)-costh
1207 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1212 uygrad(l,k,j,i)=uyder(l,k,j)
1213 uzgrad(l,k,j,i)=uzder(l,k,j)
1217 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1218 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1219 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1220 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1224 C Compute the Z-axis
1225 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1226 costh=dcos(pi-theta(i+2))
1227 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1232 C Compute the derivatives of uz
1234 uzder(2,1,1)=-dc_norm(3,i+1)
1235 uzder(3,1,1)= dc_norm(2,i+1)
1236 uzder(1,2,1)= dc_norm(3,i+1)
1238 uzder(3,2,1)=-dc_norm(1,i+1)
1239 uzder(1,3,1)=-dc_norm(2,i+1)
1240 uzder(2,3,1)= dc_norm(1,i+1)
1243 uzder(2,1,2)= dc_norm(3,i)
1244 uzder(3,1,2)=-dc_norm(2,i)
1245 uzder(1,2,2)=-dc_norm(3,i)
1247 uzder(3,2,2)= dc_norm(1,i)
1248 uzder(1,3,2)= dc_norm(2,i)
1249 uzder(2,3,2)=-dc_norm(1,i)
1252 C Compute the Y-axis
1255 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1258 C Compute the derivatives of uy
1261 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1262 & -dc_norm(k,i)*dc_norm(j,i+1)
1263 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1265 uyder(j,j,1)=uyder(j,j,1)-costh
1266 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1271 uygrad(l,k,j,i)=uyder(l,k,j)
1272 uzgrad(l,k,j,i)=uzder(l,k,j)
1276 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1277 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1278 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1279 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1285 vbld_inv_temp(1)=vbld_inv(i+1)
1286 if (i.lt.nres-1) then
1287 vbld_inv_temp(2)=vbld_inv(i+2)
1289 vbld_inv_temp(2)=vbld_inv(i)
1294 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1295 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1303 C-----------------------------------------------------------------------------
1304 subroutine vec_and_deriv_test
1305 implicit real*8 (a-h,o-z)
1306 include 'DIMENSIONS'
1307 include 'DIMENSIONS.ZSCOPT'
1308 include 'COMMON.IOUNITS'
1309 include 'COMMON.GEO'
1310 include 'COMMON.VAR'
1311 include 'COMMON.LOCAL'
1312 include 'COMMON.CHAIN'
1313 include 'COMMON.VECTORS'
1314 dimension uyder(3,3,2),uzder(3,3,2)
1315 C Compute the local reference systems. For reference system (i), the
1316 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1317 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1319 if (i.eq.nres-1) then
1320 C Case of the last full residue
1321 C Compute the Z-axis
1322 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1323 costh=dcos(pi-theta(nres))
1324 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1325 c write (iout,*) 'fac',fac,
1326 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1327 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1331 C Compute the derivatives of uz
1333 uzder(2,1,1)=-dc_norm(3,i-1)
1334 uzder(3,1,1)= dc_norm(2,i-1)
1335 uzder(1,2,1)= dc_norm(3,i-1)
1337 uzder(3,2,1)=-dc_norm(1,i-1)
1338 uzder(1,3,1)=-dc_norm(2,i-1)
1339 uzder(2,3,1)= dc_norm(1,i-1)
1342 uzder(2,1,2)= dc_norm(3,i)
1343 uzder(3,1,2)=-dc_norm(2,i)
1344 uzder(1,2,2)=-dc_norm(3,i)
1346 uzder(3,2,2)= dc_norm(1,i)
1347 uzder(1,3,2)= dc_norm(2,i)
1348 uzder(2,3,2)=-dc_norm(1,i)
1350 C Compute the Y-axis
1352 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1355 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1356 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1357 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1359 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1362 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1363 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1366 c write (iout,*) 'facy',facy,
1367 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1368 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1370 uy(k,i)=facy*uy(k,i)
1372 C Compute the derivatives of uy
1375 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1376 & -dc_norm(k,i)*dc_norm(j,i-1)
1377 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1379 c uyder(j,j,1)=uyder(j,j,1)-costh
1380 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1381 uyder(j,j,1)=uyder(j,j,1)
1382 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1383 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1389 uygrad(l,k,j,i)=uyder(l,k,j)
1390 uzgrad(l,k,j,i)=uzder(l,k,j)
1394 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1395 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1396 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1397 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1400 C Compute the Z-axis
1401 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1402 costh=dcos(pi-theta(i+2))
1403 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1404 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1408 C Compute the derivatives of uz
1410 uzder(2,1,1)=-dc_norm(3,i+1)
1411 uzder(3,1,1)= dc_norm(2,i+1)
1412 uzder(1,2,1)= dc_norm(3,i+1)
1414 uzder(3,2,1)=-dc_norm(1,i+1)
1415 uzder(1,3,1)=-dc_norm(2,i+1)
1416 uzder(2,3,1)= dc_norm(1,i+1)
1419 uzder(2,1,2)= dc_norm(3,i)
1420 uzder(3,1,2)=-dc_norm(2,i)
1421 uzder(1,2,2)=-dc_norm(3,i)
1423 uzder(3,2,2)= dc_norm(1,i)
1424 uzder(1,3,2)= dc_norm(2,i)
1425 uzder(2,3,2)=-dc_norm(1,i)
1427 C Compute the Y-axis
1429 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1430 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1431 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1433 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1436 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1437 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1440 c write (iout,*) 'facy',facy,
1441 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1442 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1444 uy(k,i)=facy*uy(k,i)
1446 C Compute the derivatives of uy
1449 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1450 & -dc_norm(k,i)*dc_norm(j,i+1)
1451 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1453 c uyder(j,j,1)=uyder(j,j,1)-costh
1454 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1455 uyder(j,j,1)=uyder(j,j,1)
1456 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1457 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1463 uygrad(l,k,j,i)=uyder(l,k,j)
1464 uzgrad(l,k,j,i)=uzder(l,k,j)
1468 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1469 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1470 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1471 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1478 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1479 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1486 C-----------------------------------------------------------------------------
1487 subroutine check_vecgrad
1488 implicit real*8 (a-h,o-z)
1489 include 'DIMENSIONS'
1490 include 'DIMENSIONS.ZSCOPT'
1491 include 'COMMON.IOUNITS'
1492 include 'COMMON.GEO'
1493 include 'COMMON.VAR'
1494 include 'COMMON.LOCAL'
1495 include 'COMMON.CHAIN'
1496 include 'COMMON.VECTORS'
1497 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1498 dimension uyt(3,maxres),uzt(3,maxres)
1499 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1500 double precision delta /1.0d-7/
1503 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1504 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1505 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1506 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1507 cd & (dc_norm(if90,i),if90=1,3)
1508 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1509 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1510 cd write(iout,'(a)')
1516 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1517 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1530 cd write (iout,*) 'i=',i
1532 erij(k)=dc_norm(k,i)
1536 dc_norm(k,i)=erij(k)
1538 dc_norm(j,i)=dc_norm(j,i)+delta
1539 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1541 c dc_norm(k,i)=dc_norm(k,i)/fac
1543 c write (iout,*) (dc_norm(k,i),k=1,3)
1544 c write (iout,*) (erij(k),k=1,3)
1547 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1548 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1549 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1550 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1552 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1553 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1554 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1557 dc_norm(k,i)=erij(k)
1560 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1561 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1562 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1563 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1564 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1565 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1566 cd write (iout,'(a)')
1571 C--------------------------------------------------------------------------
1572 subroutine set_matrices
1573 implicit real*8 (a-h,o-z)
1574 include 'DIMENSIONS'
1575 include 'DIMENSIONS.ZSCOPT'
1576 include 'COMMON.IOUNITS'
1577 include 'COMMON.GEO'
1578 include 'COMMON.VAR'
1579 include 'COMMON.LOCAL'
1580 include 'COMMON.CHAIN'
1581 include 'COMMON.DERIV'
1582 include 'COMMON.INTERACT'
1583 include 'COMMON.CONTACTS'
1584 include 'COMMON.TORSION'
1585 include 'COMMON.VECTORS'
1586 include 'COMMON.FFIELD'
1587 double precision auxvec(2),auxmat(2,2)
1589 C Compute the virtual-bond-torsional-angle dependent quantities needed
1590 C to calculate the el-loc multibody terms of various order.
1593 if (i .lt. nres+1) then
1630 if (i .gt. 3 .and. i .lt. nres+1) then
1631 obrot_der(1,i-2)=-sin1
1632 obrot_der(2,i-2)= cos1
1633 Ugder(1,1,i-2)= sin1
1634 Ugder(1,2,i-2)=-cos1
1635 Ugder(2,1,i-2)=-cos1
1636 Ugder(2,2,i-2)=-sin1
1639 obrot2_der(1,i-2)=-dwasin2
1640 obrot2_der(2,i-2)= dwacos2
1641 Ug2der(1,1,i-2)= dwasin2
1642 Ug2der(1,2,i-2)=-dwacos2
1643 Ug2der(2,1,i-2)=-dwacos2
1644 Ug2der(2,2,i-2)=-dwasin2
1646 obrot_der(1,i-2)=0.0d0
1647 obrot_der(2,i-2)=0.0d0
1648 Ugder(1,1,i-2)=0.0d0
1649 Ugder(1,2,i-2)=0.0d0
1650 Ugder(2,1,i-2)=0.0d0
1651 Ugder(2,2,i-2)=0.0d0
1652 obrot2_der(1,i-2)=0.0d0
1653 obrot2_der(2,i-2)=0.0d0
1654 Ug2der(1,1,i-2)=0.0d0
1655 Ug2der(1,2,i-2)=0.0d0
1656 Ug2der(2,1,i-2)=0.0d0
1657 Ug2der(2,2,i-2)=0.0d0
1659 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1660 if (itype(i-2).le.ntyp) then
1661 iti = itortyp(itype(i-2))
1668 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1669 if (itype(i-1).le.ntyp) then
1670 iti1 = itortyp(itype(i-1))
1677 cd write (iout,*) '*******i',i,' iti1',iti
1678 cd write (iout,*) 'b1',b1(:,iti)
1679 cd write (iout,*) 'b2',b2(:,iti)
1680 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1681 c print *,"itilde1 i iti iti1",i,iti,iti1
1682 if (i .gt. iatel_s+2) then
1683 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1684 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1685 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1686 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1687 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1688 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1689 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1699 DtUg2(l,k,i-2)=0.0d0
1703 c print *,"itilde2 i iti iti1",i,iti,iti1
1704 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1705 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1706 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1707 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1708 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1709 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1710 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1711 c print *,"itilde3 i iti iti1",i,iti,iti1
1713 muder(k,i-2)=Ub2der(k,i-2)
1715 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1716 if (itype(i-1).le.ntyp) then
1717 iti1 = itortyp(itype(i-1))
1725 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1727 C Vectors and matrices dependent on a single virtual-bond dihedral.
1728 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1729 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1730 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1731 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1732 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1733 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1734 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1735 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1736 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1737 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1738 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1740 C Matrices dependent on two consecutive virtual-bond dihedrals.
1741 C The order of matrices is from left to right.
1743 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1744 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1745 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1746 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1747 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1748 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1749 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1750 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1753 cd iti = itortyp(itype(i))
1756 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1757 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1762 C--------------------------------------------------------------------------
1763 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1765 C This subroutine calculates the average interaction energy and its gradient
1766 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1767 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1768 C The potential depends both on the distance of peptide-group centers and on
1769 C the orientation of the CA-CA virtual bonds.
1771 implicit real*8 (a-h,o-z)
1772 include 'DIMENSIONS'
1773 include 'DIMENSIONS.ZSCOPT'
1774 include 'COMMON.CONTROL'
1775 include 'COMMON.IOUNITS'
1776 include 'COMMON.GEO'
1777 include 'COMMON.VAR'
1778 include 'COMMON.LOCAL'
1779 include 'COMMON.CHAIN'
1780 include 'COMMON.DERIV'
1781 include 'COMMON.INTERACT'
1782 include 'COMMON.CONTACTS'
1783 include 'COMMON.TORSION'
1784 include 'COMMON.VECTORS'
1785 include 'COMMON.FFIELD'
1786 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1787 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1788 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1789 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1790 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1791 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1792 double precision scal_el /0.5d0/
1794 C 13-go grudnia roku pamietnego...
1795 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1796 & 0.0d0,1.0d0,0.0d0,
1797 & 0.0d0,0.0d0,1.0d0/
1798 cd write(iout,*) 'In EELEC'
1800 cd write(iout,*) 'Type',i
1801 cd write(iout,*) 'B1',B1(:,i)
1802 cd write(iout,*) 'B2',B2(:,i)
1803 cd write(iout,*) 'CC',CC(:,:,i)
1804 cd write(iout,*) 'DD',DD(:,:,i)
1805 cd write(iout,*) 'EE',EE(:,:,i)
1807 cd call check_vecgrad
1809 if (icheckgrad.eq.1) then
1811 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1813 dc_norm(k,i)=dc(k,i)*fac
1815 c write (iout,*) 'i',i,' fac',fac
1818 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1819 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1820 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1821 cd if (wel_loc.gt.0.0d0) then
1822 if (icheckgrad.eq.1) then
1823 call vec_and_deriv_test
1830 cd write (iout,*) 'i=',i
1832 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1835 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1836 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1849 cd print '(a)','Enter EELEC'
1850 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1852 gel_loc_loc(i)=0.0d0
1855 do i=iatel_s,iatel_e
1856 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
1857 if (itel(i).eq.0) goto 1215
1861 dx_normi=dc_norm(1,i)
1862 dy_normi=dc_norm(2,i)
1863 dz_normi=dc_norm(3,i)
1864 xmedi=c(1,i)+0.5d0*dxi
1865 ymedi=c(2,i)+0.5d0*dyi
1866 zmedi=c(3,i)+0.5d0*dzi
1868 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1869 do j=ielstart(i),ielend(i)
1870 if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
1871 if (itel(j).eq.0) goto 1216
1875 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1876 aaa=app(iteli,itelj)
1877 bbb=bpp(iteli,itelj)
1878 C Diagnostics only!!!
1884 ael6i=ael6(iteli,itelj)
1885 ael3i=ael3(iteli,itelj)
1889 dx_normj=dc_norm(1,j)
1890 dy_normj=dc_norm(2,j)
1891 dz_normj=dc_norm(3,j)
1892 xj=c(1,j)+0.5D0*dxj-xmedi
1893 yj=c(2,j)+0.5D0*dyj-ymedi
1894 zj=c(3,j)+0.5D0*dzj-zmedi
1895 rij=xj*xj+yj*yj+zj*zj
1901 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1902 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1903 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1904 fac=cosa-3.0D0*cosb*cosg
1906 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1907 if (j.eq.i+2) ev1=scal_el*ev1
1912 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1915 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1916 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1917 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1920 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1921 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1922 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1923 cd & xmedi,ymedi,zmedi,xj,yj,zj
1925 C Calculate contributions to the Cartesian gradient.
1928 facvdw=-6*rrmij*(ev1+evdwij)
1929 facel=-3*rrmij*(el1+eesij)
1936 * Radial derivatives. First process both termini of the fragment (i,j)
1943 gelc(k,i)=gelc(k,i)+ghalf
1944 gelc(k,j)=gelc(k,j)+ghalf
1947 * Loop over residues i+1 thru j-1.
1951 gelc(l,k)=gelc(l,k)+ggg(l)
1959 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1960 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1963 * Loop over residues i+1 thru j-1.
1967 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1974 fac=-3*rrmij*(facvdw+facvdw+facel)
1980 * Radial derivatives. First process both termini of the fragment (i,j)
1987 gelc(k,i)=gelc(k,i)+ghalf
1988 gelc(k,j)=gelc(k,j)+ghalf
1991 * Loop over residues i+1 thru j-1.
1995 gelc(l,k)=gelc(l,k)+ggg(l)
2002 ecosa=2.0D0*fac3*fac1+fac4
2005 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2006 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2008 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2009 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2011 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2012 cd & (dcosg(k),k=1,3)
2014 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2018 gelc(k,i)=gelc(k,i)+ghalf
2019 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2020 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2021 gelc(k,j)=gelc(k,j)+ghalf
2022 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2023 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2027 gelc(l,k)=gelc(l,k)+ggg(l)
2032 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2033 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2034 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2036 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2037 C energy of a peptide unit is assumed in the form of a second-order
2038 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2039 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2040 C are computed for EVERY pair of non-contiguous peptide groups.
2042 if (j.lt.nres-1) then
2053 muij(kkk)=mu(k,i)*mu(l,j)
2056 cd write (iout,*) 'EELEC: i',i,' j',j
2057 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2058 cd write(iout,*) 'muij',muij
2059 ury=scalar(uy(1,i),erij)
2060 urz=scalar(uz(1,i),erij)
2061 vry=scalar(uy(1,j),erij)
2062 vrz=scalar(uz(1,j),erij)
2063 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2064 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2065 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2066 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2067 C For diagnostics only
2072 fac=dsqrt(-ael6i)*r3ij
2073 cd write (2,*) 'fac=',fac
2074 C For diagnostics only
2080 cd write (iout,'(4i5,4f10.5)')
2081 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2082 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2083 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2084 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2085 cd write (iout,'(4f10.5)')
2086 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2087 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2088 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2089 cd write (iout,'(2i3,9f10.5/)') i,j,
2090 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2092 C Derivatives of the elements of A in virtual-bond vectors
2093 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2100 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2101 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2102 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2103 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2104 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2105 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2106 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2107 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2108 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2109 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2110 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2111 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2121 C Compute radial contributions to the gradient
2143 C Add the contributions coming from er
2146 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2147 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2148 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2149 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2152 C Derivatives in DC(i)
2153 ghalf1=0.5d0*agg(k,1)
2154 ghalf2=0.5d0*agg(k,2)
2155 ghalf3=0.5d0*agg(k,3)
2156 ghalf4=0.5d0*agg(k,4)
2157 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2158 & -3.0d0*uryg(k,2)*vry)+ghalf1
2159 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2160 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2161 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2162 & -3.0d0*urzg(k,2)*vry)+ghalf3
2163 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2164 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2165 C Derivatives in DC(i+1)
2166 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2167 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2168 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2169 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2170 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2171 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2172 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2173 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2174 C Derivatives in DC(j)
2175 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2176 & -3.0d0*vryg(k,2)*ury)+ghalf1
2177 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2178 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2179 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2180 & -3.0d0*vryg(k,2)*urz)+ghalf3
2181 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2182 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2183 C Derivatives in DC(j+1) or DC(nres-1)
2184 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2185 & -3.0d0*vryg(k,3)*ury)
2186 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2187 & -3.0d0*vrzg(k,3)*ury)
2188 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2189 & -3.0d0*vryg(k,3)*urz)
2190 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2191 & -3.0d0*vrzg(k,3)*urz)
2196 C Derivatives in DC(i+1)
2197 cd aggi1(k,1)=agg(k,1)
2198 cd aggi1(k,2)=agg(k,2)
2199 cd aggi1(k,3)=agg(k,3)
2200 cd aggi1(k,4)=agg(k,4)
2201 C Derivatives in DC(j)
2206 C Derivatives in DC(j+1)
2211 if (j.eq.nres-1 .and. i.lt.j-2) then
2213 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2214 cd aggj1(k,l)=agg(k,l)
2220 C Check the loc-el terms by numerical integration
2230 aggi(k,l)=-aggi(k,l)
2231 aggi1(k,l)=-aggi1(k,l)
2232 aggj(k,l)=-aggj(k,l)
2233 aggj1(k,l)=-aggj1(k,l)
2236 if (j.lt.nres-1) then
2242 aggi(k,l)=-aggi(k,l)
2243 aggi1(k,l)=-aggi1(k,l)
2244 aggj(k,l)=-aggj(k,l)
2245 aggj1(k,l)=-aggj1(k,l)
2256 aggi(k,l)=-aggi(k,l)
2257 aggi1(k,l)=-aggi1(k,l)
2258 aggj(k,l)=-aggj(k,l)
2259 aggj1(k,l)=-aggj1(k,l)
2265 IF (wel_loc.gt.0.0d0) THEN
2266 C Contribution to the local-electrostatic energy coming from the i-j pair
2267 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2269 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2270 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2271 eel_loc=eel_loc+eel_loc_ij
2272 C Partial derivatives in virtual-bond dihedral angles gamma
2275 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2276 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2277 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2278 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2279 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2280 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2281 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2282 cd write(iout,*) 'agg ',agg
2283 cd write(iout,*) 'aggi ',aggi
2284 cd write(iout,*) 'aggi1',aggi1
2285 cd write(iout,*) 'aggj ',aggj
2286 cd write(iout,*) 'aggj1',aggj1
2288 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2290 ggg(l)=agg(l,1)*muij(1)+
2291 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2295 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2298 C Remaining derivatives of eello
2300 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2301 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2302 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2303 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2304 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2305 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2306 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2307 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2311 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2312 C Contributions from turns
2317 call eturn34(i,j,eello_turn3,eello_turn4)
2319 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2320 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2322 C Calculate the contact function. The ith column of the array JCONT will
2323 C contain the numbers of atoms that make contacts with the atom I (of numbers
2324 C greater than I). The arrays FACONT and GACONT will contain the values of
2325 C the contact function and its derivative.
2326 c r0ij=1.02D0*rpp(iteli,itelj)
2327 c r0ij=1.11D0*rpp(iteli,itelj)
2328 r0ij=2.20D0*rpp(iteli,itelj)
2329 c r0ij=1.55D0*rpp(iteli,itelj)
2330 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2331 if (fcont.gt.0.0D0) then
2332 num_conti=num_conti+1
2333 if (num_conti.gt.maxconts) then
2334 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2335 & ' will skip next contacts for this conf.'
2337 jcont_hb(num_conti,i)=j
2338 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2339 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2340 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2342 d_cont(num_conti,i)=rij
2343 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2344 C --- Electrostatic-interaction matrix ---
2345 a_chuj(1,1,num_conti,i)=a22
2346 a_chuj(1,2,num_conti,i)=a23
2347 a_chuj(2,1,num_conti,i)=a32
2348 a_chuj(2,2,num_conti,i)=a33
2349 C --- Gradient of rij
2351 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2354 c a_chuj(1,1,num_conti,i)=-0.61d0
2355 c a_chuj(1,2,num_conti,i)= 0.4d0
2356 c a_chuj(2,1,num_conti,i)= 0.65d0
2357 c a_chuj(2,2,num_conti,i)= 0.50d0
2358 c else if (i.eq.2) then
2359 c a_chuj(1,1,num_conti,i)= 0.0d0
2360 c a_chuj(1,2,num_conti,i)= 0.0d0
2361 c a_chuj(2,1,num_conti,i)= 0.0d0
2362 c a_chuj(2,2,num_conti,i)= 0.0d0
2364 C --- and its gradients
2365 cd write (iout,*) 'i',i,' j',j
2367 cd write (iout,*) 'iii 1 kkk',kkk
2368 cd write (iout,*) agg(kkk,:)
2371 cd write (iout,*) 'iii 2 kkk',kkk
2372 cd write (iout,*) aggi(kkk,:)
2375 cd write (iout,*) 'iii 3 kkk',kkk
2376 cd write (iout,*) aggi1(kkk,:)
2379 cd write (iout,*) 'iii 4 kkk',kkk
2380 cd write (iout,*) aggj(kkk,:)
2383 cd write (iout,*) 'iii 5 kkk',kkk
2384 cd write (iout,*) aggj1(kkk,:)
2391 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2392 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2393 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2394 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2395 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2397 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2403 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2404 C Calculate contact energies
2406 wij=cosa-3.0D0*cosb*cosg
2409 c fac3=dsqrt(-ael6i)/r0ij**3
2410 fac3=dsqrt(-ael6i)*r3ij
2411 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2412 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2414 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2415 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2416 C Diagnostics. Comment out or remove after debugging!
2417 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2418 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2419 c ees0m(num_conti,i)=0.0D0
2421 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2422 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2423 facont_hb(num_conti,i)=fcont
2425 C Angular derivatives of the contact function
2426 ees0pij1=fac3/ees0pij
2427 ees0mij1=fac3/ees0mij
2428 fac3p=-3.0D0*fac3*rrmij
2429 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2430 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2432 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2433 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2434 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2435 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2436 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2437 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2438 ecosap=ecosa1+ecosa2
2439 ecosbp=ecosb1+ecosb2
2440 ecosgp=ecosg1+ecosg2
2441 ecosam=ecosa1-ecosa2
2442 ecosbm=ecosb1-ecosb2
2443 ecosgm=ecosg1-ecosg2
2452 fprimcont=fprimcont/rij
2453 cd facont_hb(num_conti,i)=1.0D0
2454 C Following line is for diagnostics.
2457 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2458 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2461 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2462 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2464 gggp(1)=gggp(1)+ees0pijp*xj
2465 gggp(2)=gggp(2)+ees0pijp*yj
2466 gggp(3)=gggp(3)+ees0pijp*zj
2467 gggm(1)=gggm(1)+ees0mijp*xj
2468 gggm(2)=gggm(2)+ees0mijp*yj
2469 gggm(3)=gggm(3)+ees0mijp*zj
2470 C Derivatives due to the contact function
2471 gacont_hbr(1,num_conti,i)=fprimcont*xj
2472 gacont_hbr(2,num_conti,i)=fprimcont*yj
2473 gacont_hbr(3,num_conti,i)=fprimcont*zj
2475 ghalfp=0.5D0*gggp(k)
2476 ghalfm=0.5D0*gggm(k)
2477 gacontp_hb1(k,num_conti,i)=ghalfp
2478 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2479 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2480 gacontp_hb2(k,num_conti,i)=ghalfp
2481 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2482 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2483 gacontp_hb3(k,num_conti,i)=gggp(k)
2484 gacontm_hb1(k,num_conti,i)=ghalfm
2485 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2486 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2487 gacontm_hb2(k,num_conti,i)=ghalfm
2488 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2489 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2490 gacontm_hb3(k,num_conti,i)=gggm(k)
2493 C Diagnostics. Comment out or remove after debugging!
2495 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2496 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2497 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2498 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2499 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2500 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2503 endif ! num_conti.le.maxconts
2508 num_cont_hb(i)=num_conti
2512 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2513 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2515 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2516 ccc eel_loc=eel_loc+eello_turn3
2519 C-----------------------------------------------------------------------------
2520 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2521 C Third- and fourth-order contributions from turns
2522 implicit real*8 (a-h,o-z)
2523 include 'DIMENSIONS'
2524 include 'DIMENSIONS.ZSCOPT'
2525 include 'COMMON.IOUNITS'
2526 include 'COMMON.GEO'
2527 include 'COMMON.VAR'
2528 include 'COMMON.LOCAL'
2529 include 'COMMON.CHAIN'
2530 include 'COMMON.DERIV'
2531 include 'COMMON.INTERACT'
2532 include 'COMMON.CONTACTS'
2533 include 'COMMON.TORSION'
2534 include 'COMMON.VECTORS'
2535 include 'COMMON.FFIELD'
2537 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2538 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2539 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2540 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2541 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2542 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2544 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2546 C Third-order contributions
2553 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2554 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2555 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2556 call transpose2(auxmat(1,1),auxmat1(1,1))
2557 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2558 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2559 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2560 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2561 cd & ' eello_turn3_num',4*eello_turn3_num
2563 C Derivatives in gamma(i)
2564 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2565 call transpose2(auxmat2(1,1),pizda(1,1))
2566 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2567 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2568 C Derivatives in gamma(i+1)
2569 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2570 call transpose2(auxmat2(1,1),pizda(1,1))
2571 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2572 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2573 & +0.5d0*(pizda(1,1)+pizda(2,2))
2574 C Cartesian derivatives
2576 a_temp(1,1)=aggi(l,1)
2577 a_temp(1,2)=aggi(l,2)
2578 a_temp(2,1)=aggi(l,3)
2579 a_temp(2,2)=aggi(l,4)
2580 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2581 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2582 & +0.5d0*(pizda(1,1)+pizda(2,2))
2583 a_temp(1,1)=aggi1(l,1)
2584 a_temp(1,2)=aggi1(l,2)
2585 a_temp(2,1)=aggi1(l,3)
2586 a_temp(2,2)=aggi1(l,4)
2587 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2588 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2589 & +0.5d0*(pizda(1,1)+pizda(2,2))
2590 a_temp(1,1)=aggj(l,1)
2591 a_temp(1,2)=aggj(l,2)
2592 a_temp(2,1)=aggj(l,3)
2593 a_temp(2,2)=aggj(l,4)
2594 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2595 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2596 & +0.5d0*(pizda(1,1)+pizda(2,2))
2597 a_temp(1,1)=aggj1(l,1)
2598 a_temp(1,2)=aggj1(l,2)
2599 a_temp(2,1)=aggj1(l,3)
2600 a_temp(2,2)=aggj1(l,4)
2601 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2602 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2603 & +0.5d0*(pizda(1,1)+pizda(2,2))
2606 else if (j.eq.i+3 .and. itype(i+2).ne.21) then
2607 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2609 C Fourth-order contributions
2617 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2618 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2619 iti1=itortyp(itype(i+1))
2620 iti2=itortyp(itype(i+2))
2621 iti3=itortyp(itype(i+3))
2622 call transpose2(EUg(1,1,i+1),e1t(1,1))
2623 call transpose2(Eug(1,1,i+2),e2t(1,1))
2624 call transpose2(Eug(1,1,i+3),e3t(1,1))
2625 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2626 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2627 s1=scalar2(b1(1,iti2),auxvec(1))
2628 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2629 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2630 s2=scalar2(b1(1,iti1),auxvec(1))
2631 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2632 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2633 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2634 eello_turn4=eello_turn4-(s1+s2+s3)
2635 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2636 cd & ' eello_turn4_num',8*eello_turn4_num
2637 C Derivatives in gamma(i)
2639 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2640 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2641 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2642 s1=scalar2(b1(1,iti2),auxvec(1))
2643 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2644 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2645 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2646 C Derivatives in gamma(i+1)
2647 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2648 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2649 s2=scalar2(b1(1,iti1),auxvec(1))
2650 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2651 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2652 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2653 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2654 C Derivatives in gamma(i+2)
2655 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2656 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2657 s1=scalar2(b1(1,iti2),auxvec(1))
2658 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2659 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2660 s2=scalar2(b1(1,iti1),auxvec(1))
2661 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2662 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2663 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2664 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2665 C Cartesian derivatives
2666 C Derivatives of this turn contributions in DC(i+2)
2667 if (j.lt.nres-1) then
2669 a_temp(1,1)=agg(l,1)
2670 a_temp(1,2)=agg(l,2)
2671 a_temp(2,1)=agg(l,3)
2672 a_temp(2,2)=agg(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))
2683 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2686 C Remaining derivatives of this turn contribution
2688 a_temp(1,1)=aggi(l,1)
2689 a_temp(1,2)=aggi(l,2)
2690 a_temp(2,1)=aggi(l,3)
2691 a_temp(2,2)=aggi(l,4)
2692 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2693 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2694 s1=scalar2(b1(1,iti2),auxvec(1))
2695 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2696 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2697 s2=scalar2(b1(1,iti1),auxvec(1))
2698 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2699 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2700 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2701 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2702 a_temp(1,1)=aggi1(l,1)
2703 a_temp(1,2)=aggi1(l,2)
2704 a_temp(2,1)=aggi1(l,3)
2705 a_temp(2,2)=aggi1(l,4)
2706 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2707 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2708 s1=scalar2(b1(1,iti2),auxvec(1))
2709 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2710 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2711 s2=scalar2(b1(1,iti1),auxvec(1))
2712 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2713 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2714 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2715 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2716 a_temp(1,1)=aggj(l,1)
2717 a_temp(1,2)=aggj(l,2)
2718 a_temp(2,1)=aggj(l,3)
2719 a_temp(2,2)=aggj(l,4)
2720 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2721 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2722 s1=scalar2(b1(1,iti2),auxvec(1))
2723 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2724 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2725 s2=scalar2(b1(1,iti1),auxvec(1))
2726 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2727 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2728 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2729 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2730 a_temp(1,1)=aggj1(l,1)
2731 a_temp(1,2)=aggj1(l,2)
2732 a_temp(2,1)=aggj1(l,3)
2733 a_temp(2,2)=aggj1(l,4)
2734 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2735 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2736 s1=scalar2(b1(1,iti2),auxvec(1))
2737 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2738 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2739 s2=scalar2(b1(1,iti1),auxvec(1))
2740 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2741 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2742 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2743 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2749 C-----------------------------------------------------------------------------
2750 subroutine vecpr(u,v,w)
2751 implicit real*8(a-h,o-z)
2752 dimension u(3),v(3),w(3)
2753 w(1)=u(2)*v(3)-u(3)*v(2)
2754 w(2)=-u(1)*v(3)+u(3)*v(1)
2755 w(3)=u(1)*v(2)-u(2)*v(1)
2758 C-----------------------------------------------------------------------------
2759 subroutine unormderiv(u,ugrad,unorm,ungrad)
2760 C This subroutine computes the derivatives of a normalized vector u, given
2761 C the derivatives computed without normalization conditions, ugrad. Returns
2764 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2765 double precision vec(3)
2766 double precision scalar
2768 c write (2,*) 'ugrad',ugrad
2771 vec(i)=scalar(ugrad(1,i),u(1))
2773 c write (2,*) 'vec',vec
2776 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2779 c write (2,*) 'ungrad',ungrad
2782 C-----------------------------------------------------------------------------
2783 subroutine escp(evdw2,evdw2_14)
2785 C This subroutine calculates the excluded-volume interaction energy between
2786 C peptide-group centers and side chains and its gradient in virtual-bond and
2787 C side-chain vectors.
2789 implicit real*8 (a-h,o-z)
2790 include 'DIMENSIONS'
2791 include 'DIMENSIONS.ZSCOPT'
2792 include 'COMMON.GEO'
2793 include 'COMMON.VAR'
2794 include 'COMMON.LOCAL'
2795 include 'COMMON.CHAIN'
2796 include 'COMMON.DERIV'
2797 include 'COMMON.INTERACT'
2798 include 'COMMON.FFIELD'
2799 include 'COMMON.IOUNITS'
2803 cd print '(a)','Enter ESCP'
2804 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2805 c & ' scal14',scal14
2806 do i=iatscp_s,iatscp_e
2807 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
2809 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2810 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2811 if (iteli.eq.0) goto 1225
2812 xi=0.5D0*(c(1,i)+c(1,i+1))
2813 yi=0.5D0*(c(2,i)+c(2,i+1))
2814 zi=0.5D0*(c(3,i)+c(3,i+1))
2816 do iint=1,nscp_gr(i)
2818 do j=iscpstart(i,iint),iscpend(i,iint)
2819 itypj=iabs(itype(j))
2820 if (itypj.eq.21) cycle
2821 C Uncomment following three lines for SC-p interactions
2825 C Uncomment following three lines for Ca-p interactions
2829 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2831 e1=fac*fac*aad(itypj,iteli)
2832 e2=fac*bad(itypj,iteli)
2833 if (iabs(j-i) .le. 2) then
2836 evdw2_14=evdw2_14+e1+e2
2839 c write (iout,*) i,j,evdwij
2843 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2845 fac=-(evdwij+e1)*rrij
2850 cd write (iout,*) 'j<i'
2851 C Uncomment following three lines for SC-p interactions
2853 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2856 cd write (iout,*) 'j>i'
2859 C Uncomment following line for SC-p interactions
2860 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2864 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2868 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2869 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2872 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2882 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2883 gradx_scp(j,i)=expon*gradx_scp(j,i)
2886 C******************************************************************************
2890 C To save time the factor EXPON has been extracted from ALL components
2891 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2894 C******************************************************************************
2897 C--------------------------------------------------------------------------
2898 subroutine edis(ehpb)
2900 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2902 implicit real*8 (a-h,o-z)
2903 include 'DIMENSIONS'
2904 include 'DIMENSIONS.ZSCOPT'
2905 include 'COMMON.SBRIDGE'
2906 include 'COMMON.CHAIN'
2907 include 'COMMON.DERIV'
2908 include 'COMMON.VAR'
2909 include 'COMMON.INTERACT'
2912 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2913 cd print *,'link_start=',link_start,' link_end=',link_end
2914 if (link_end.eq.0) return
2915 do i=link_start,link_end
2916 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2917 C CA-CA distance used in regularization of structure.
2920 C iii and jjj point to the residues for which the distance is assigned.
2921 if (ii.gt.nres) then
2928 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2929 C distance and angle dependent SS bond potential.
2930 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2931 & iabs(itype(jjj)).eq.1) then
2932 call ssbond_ene(iii,jjj,eij)
2935 C Calculate the distance between the two points and its difference from the
2939 C Get the force constant corresponding to this distance.
2941 C Calculate the contribution to energy.
2942 ehpb=ehpb+waga*rdis*rdis
2944 C Evaluate gradient.
2947 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2948 cd & ' waga=',waga,' fac=',fac
2950 ggg(j)=fac*(c(j,jj)-c(j,ii))
2952 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2953 C If this is a SC-SC distance, we need to calculate the contributions to the
2954 C Cartesian gradient in the SC vectors (ghpbx).
2957 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2958 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2963 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2971 C--------------------------------------------------------------------------
2972 subroutine ssbond_ene(i,j,eij)
2974 C Calculate the distance and angle dependent SS-bond potential energy
2975 C using a free-energy function derived based on RHF/6-31G** ab initio
2976 C calculations of diethyl disulfide.
2978 C A. Liwo and U. Kozlowska, 11/24/03
2980 implicit real*8 (a-h,o-z)
2981 include 'DIMENSIONS'
2982 include 'DIMENSIONS.ZSCOPT'
2983 include 'COMMON.SBRIDGE'
2984 include 'COMMON.CHAIN'
2985 include 'COMMON.DERIV'
2986 include 'COMMON.LOCAL'
2987 include 'COMMON.INTERACT'
2988 include 'COMMON.VAR'
2989 include 'COMMON.IOUNITS'
2990 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2991 itypi=iabs(itype(i))
2995 dxi=dc_norm(1,nres+i)
2996 dyi=dc_norm(2,nres+i)
2997 dzi=dc_norm(3,nres+i)
2998 dsci_inv=dsc_inv(itypi)
2999 itypj=iabs(itype(j))
3000 dscj_inv=dsc_inv(itypj)
3004 dxj=dc_norm(1,nres+j)
3005 dyj=dc_norm(2,nres+j)
3006 dzj=dc_norm(3,nres+j)
3007 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3012 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3013 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3014 om12=dxi*dxj+dyi*dyj+dzi*dzj
3016 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3017 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3023 deltat12=om2-om1+2.0d0
3025 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3026 & +akct*deltad*deltat12
3027 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3028 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3029 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3030 c & " deltat12",deltat12," eij",eij
3031 ed=2*akcm*deltad+akct*deltat12
3033 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3034 eom1=-2*akth*deltat1-pom1-om2*pom2
3035 eom2= 2*akth*deltat2+pom1-om1*pom2
3038 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3041 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3042 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3043 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3044 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3047 C Calculate the components of the gradient in DC and X
3051 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3056 C--------------------------------------------------------------------------
3057 subroutine ebond(estr)
3059 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3061 implicit real*8 (a-h,o-z)
3062 include 'DIMENSIONS'
3063 include 'DIMENSIONS.ZSCOPT'
3064 include 'COMMON.LOCAL'
3065 include 'COMMON.GEO'
3066 include 'COMMON.INTERACT'
3067 include 'COMMON.DERIV'
3068 include 'COMMON.VAR'
3069 include 'COMMON.CHAIN'
3070 include 'COMMON.IOUNITS'
3071 include 'COMMON.NAMES'
3072 include 'COMMON.FFIELD'
3073 include 'COMMON.CONTROL'
3074 logical energy_dec /.false./
3075 double precision u(3),ud(3)
3078 write (iout,*) "distchainmax",distchainmax
3080 if (itype(i-1).eq.21 .or. itype(i).eq.21) then
3081 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3083 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3084 & *dc(j,i-1)/vbld(i)
3086 if (energy_dec) write(iout,*)
3087 & "estr1",i,vbld(i),distchainmax,
3088 & gnmr1(vbld(i),-1.0d0,distchainmax)
3090 diff = vbld(i)-vbldp0
3091 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3094 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3099 estr=0.5d0*AKP*estr+estr1
3101 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3105 if (iti.ne.10 .and. iti.ne.21) then
3108 diff=vbld(i+nres)-vbldsc0(1,iti)
3109 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3110 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3111 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3113 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3117 diff=vbld(i+nres)-vbldsc0(j,iti)
3118 ud(j)=aksc(j,iti)*diff
3119 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3133 uprod2=uprod2*u(k)*u(k)
3137 usumsqder=usumsqder+ud(j)*uprod2
3139 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3140 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3141 estr=estr+uprod/usum
3143 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3151 C--------------------------------------------------------------------------
3152 subroutine ebend(etheta)
3154 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3155 C angles gamma and its derivatives in consecutive thetas and gammas.
3157 implicit real*8 (a-h,o-z)
3158 include 'DIMENSIONS'
3159 include 'DIMENSIONS.ZSCOPT'
3160 include 'COMMON.LOCAL'
3161 include 'COMMON.GEO'
3162 include 'COMMON.INTERACT'
3163 include 'COMMON.DERIV'
3164 include 'COMMON.VAR'
3165 include 'COMMON.CHAIN'
3166 include 'COMMON.IOUNITS'
3167 include 'COMMON.NAMES'
3168 include 'COMMON.FFIELD'
3169 common /calcthet/ term1,term2,termm,diffak,ratak,
3170 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3171 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3172 double precision y(2),z(2)
3174 time11=dexp(-2*time)
3177 c write (iout,*) "nres",nres
3178 c write (*,'(a,i2)') 'EBEND ICG=',icg
3179 c write (iout,*) ithet_start,ithet_end
3180 do i=ithet_start,ithet_end
3181 if (itype(i-1).eq.21) cycle
3182 C Zero the energy function and its derivative at 0 or pi.
3183 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3185 ichir1=isign(1,itype(i-2))
3186 ichir2=isign(1,itype(i))
3187 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3188 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3189 if (itype(i-1).eq.10) then
3190 itype1=isign(10,itype(i-2))
3191 ichir11=isign(1,itype(i-2))
3192 ichir12=isign(1,itype(i-2))
3193 itype2=isign(10,itype(i))
3194 ichir21=isign(1,itype(i))
3195 ichir22=isign(1,itype(i))
3198 if (i.gt.3 .and. itype(i-2).ne.21) then
3202 call proc_proc(phii,icrc)
3203 if (icrc.eq.1) phii=150.0
3213 if (i.lt.nres .and. itype(i).ne.21) then
3217 call proc_proc(phii1,icrc)
3218 if (icrc.eq.1) phii1=150.0
3230 C Calculate the "mean" value of theta from the part of the distribution
3231 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3232 C In following comments this theta will be referred to as t_c.
3233 thet_pred_mean=0.0d0
3235 athetk=athet(k,it,ichir1,ichir2)
3236 bthetk=bthet(k,it,ichir1,ichir2)
3238 athetk=athet(k,itype1,ichir11,ichir12)
3239 bthetk=bthet(k,itype2,ichir21,ichir22)
3241 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3243 c write (iout,*) "thet_pred_mean",thet_pred_mean
3244 dthett=thet_pred_mean*ssd
3245 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3246 c write (iout,*) "thet_pred_mean",thet_pred_mean
3247 C Derivatives of the "mean" values in gamma1 and gamma2.
3248 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3249 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3250 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3251 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3253 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3254 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3255 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3256 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3258 if (theta(i).gt.pi-delta) then
3259 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3261 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3262 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3263 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3265 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3267 else if (theta(i).lt.delta) then
3268 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3269 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3270 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3272 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3273 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3276 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3279 etheta=etheta+ethetai
3280 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3281 c & rad2deg*phii,rad2deg*phii1,ethetai
3282 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3283 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3284 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3287 C Ufff.... We've done all this!!!
3290 C---------------------------------------------------------------------------
3291 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3293 implicit real*8 (a-h,o-z)
3294 include 'DIMENSIONS'
3295 include 'COMMON.LOCAL'
3296 include 'COMMON.IOUNITS'
3297 common /calcthet/ term1,term2,termm,diffak,ratak,
3298 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3299 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3300 C Calculate the contributions to both Gaussian lobes.
3301 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3302 C The "polynomial part" of the "standard deviation" of this part of
3306 sig=sig*thet_pred_mean+polthet(j,it)
3308 C Derivative of the "interior part" of the "standard deviation of the"
3309 C gamma-dependent Gaussian lobe in t_c.
3310 sigtc=3*polthet(3,it)
3312 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3315 C Set the parameters of both Gaussian lobes of the distribution.
3316 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3317 fac=sig*sig+sigc0(it)
3320 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3321 sigsqtc=-4.0D0*sigcsq*sigtc
3322 c print *,i,sig,sigtc,sigsqtc
3323 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3324 sigtc=-sigtc/(fac*fac)
3325 C Following variable is sigma(t_c)**(-2)
3326 sigcsq=sigcsq*sigcsq
3328 sig0inv=1.0D0/sig0i**2
3329 delthec=thetai-thet_pred_mean
3330 delthe0=thetai-theta0i
3331 term1=-0.5D0*sigcsq*delthec*delthec
3332 term2=-0.5D0*sig0inv*delthe0*delthe0
3333 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3334 C NaNs in taking the logarithm. We extract the largest exponent which is added
3335 C to the energy (this being the log of the distribution) at the end of energy
3336 C term evaluation for this virtual-bond angle.
3337 if (term1.gt.term2) then
3339 term2=dexp(term2-termm)
3343 term1=dexp(term1-termm)
3346 C The ratio between the gamma-independent and gamma-dependent lobes of
3347 C the distribution is a Gaussian function of thet_pred_mean too.
3348 diffak=gthet(2,it)-thet_pred_mean
3349 ratak=diffak/gthet(3,it)**2
3350 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3351 C Let's differentiate it in thet_pred_mean NOW.
3353 C Now put together the distribution terms to make complete distribution.
3354 termexp=term1+ak*term2
3355 termpre=sigc+ak*sig0i
3356 C Contribution of the bending energy from this theta is just the -log of
3357 C the sum of the contributions from the two lobes and the pre-exponential
3358 C factor. Simple enough, isn't it?
3359 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3360 C NOW the derivatives!!!
3361 C 6/6/97 Take into account the deformation.
3362 E_theta=(delthec*sigcsq*term1
3363 & +ak*delthe0*sig0inv*term2)/termexp
3364 E_tc=((sigtc+aktc*sig0i)/termpre
3365 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3366 & aktc*term2)/termexp)
3369 c-----------------------------------------------------------------------------
3370 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3371 implicit real*8 (a-h,o-z)
3372 include 'DIMENSIONS'
3373 include 'COMMON.LOCAL'
3374 include 'COMMON.IOUNITS'
3375 common /calcthet/ term1,term2,termm,diffak,ratak,
3376 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3377 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3378 delthec=thetai-thet_pred_mean
3379 delthe0=thetai-theta0i
3380 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3381 t3 = thetai-thet_pred_mean
3385 t14 = t12+t6*sigsqtc
3387 t21 = thetai-theta0i
3393 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3394 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3395 & *(-t12*t9-ak*sig0inv*t27)
3399 C--------------------------------------------------------------------------
3400 subroutine ebend(etheta)
3402 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3403 C angles gamma and its derivatives in consecutive thetas and gammas.
3404 C ab initio-derived potentials from
3405 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3407 implicit real*8 (a-h,o-z)
3408 include 'DIMENSIONS'
3409 include 'DIMENSIONS.ZSCOPT'
3410 include 'COMMON.LOCAL'
3411 include 'COMMON.GEO'
3412 include 'COMMON.INTERACT'
3413 include 'COMMON.DERIV'
3414 include 'COMMON.VAR'
3415 include 'COMMON.CHAIN'
3416 include 'COMMON.IOUNITS'
3417 include 'COMMON.NAMES'
3418 include 'COMMON.FFIELD'
3419 include 'COMMON.CONTROL'
3420 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3421 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3422 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3423 & sinph1ph2(maxdouble,maxdouble)
3424 logical lprn /.false./, lprn1 /.false./
3426 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3427 do i=ithet_start,ithet_end
3428 if (itype(i-1).eq.21) cycle
3432 theti2=0.5d0*theta(i)
3433 ityp2=ithetyp(iabs(itype(i-1)))
3435 coskt(k)=dcos(k*theti2)
3436 sinkt(k)=dsin(k*theti2)
3438 if (i.gt.3 .and. itype(i-2).ne.21) then
3441 if (phii.ne.phii) phii=150.0
3445 ityp1=ithetyp(iabs(itype(i-2)))
3447 cosph1(k)=dcos(k*phii)
3448 sinph1(k)=dsin(k*phii)
3458 if (i.lt.nres .and. itype(i).ne.21) then
3461 if (phii1.ne.phii1) phii1=150.0
3466 ityp3=ithetyp(iabs(itype(i)))
3468 cosph2(k)=dcos(k*phii1)
3469 sinph2(k)=dsin(k*phii1)
3479 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3480 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3482 ethetai=aa0thet(ityp1,ityp2,ityp3)
3485 ccl=cosph1(l)*cosph2(k-l)
3486 ssl=sinph1(l)*sinph2(k-l)
3487 scl=sinph1(l)*cosph2(k-l)
3488 csl=cosph1(l)*sinph2(k-l)
3489 cosph1ph2(l,k)=ccl-ssl
3490 cosph1ph2(k,l)=ccl+ssl
3491 sinph1ph2(l,k)=scl+csl
3492 sinph1ph2(k,l)=scl-csl
3496 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3497 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3498 write (iout,*) "coskt and sinkt"
3500 write (iout,*) k,coskt(k),sinkt(k)
3504 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3505 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3508 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3509 & " ethetai",ethetai
3512 write (iout,*) "cosph and sinph"
3514 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3516 write (iout,*) "cosph1ph2 and sinph2ph2"
3519 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3520 & sinph1ph2(l,k),sinph1ph2(k,l)
3523 write(iout,*) "ethetai",ethetai
3527 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3528 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3529 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3530 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3531 ethetai=ethetai+sinkt(m)*aux
3532 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3533 dephii=dephii+k*sinkt(m)*(
3534 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3535 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3536 dephii1=dephii1+k*sinkt(m)*(
3537 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3538 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3540 & write (iout,*) "m",m," k",k," bbthet",
3541 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3542 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3543 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3544 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3548 & write(iout,*) "ethetai",ethetai
3552 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3553 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3554 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3555 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3556 ethetai=ethetai+sinkt(m)*aux
3557 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3558 dephii=dephii+l*sinkt(m)*(
3559 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3560 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3561 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3562 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3563 dephii1=dephii1+(k-l)*sinkt(m)*(
3564 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3565 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3566 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3567 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3569 write (iout,*) "m",m," k",k," l",l," ffthet",
3570 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3571 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3572 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3573 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3574 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3575 & cosph1ph2(k,l)*sinkt(m),
3576 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3582 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3583 & i,theta(i)*rad2deg,phii*rad2deg,
3584 & phii1*rad2deg,ethetai
3585 etheta=etheta+ethetai
3586 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3587 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3588 gloc(nphi+i-2,icg)=wang*dethetai
3594 c-----------------------------------------------------------------------------
3595 subroutine esc(escloc)
3596 C Calculate the local energy of a side chain and its derivatives in the
3597 C corresponding virtual-bond valence angles THETA and the spherical angles
3599 implicit real*8 (a-h,o-z)
3600 include 'DIMENSIONS'
3601 include 'DIMENSIONS.ZSCOPT'
3602 include 'COMMON.GEO'
3603 include 'COMMON.LOCAL'
3604 include 'COMMON.VAR'
3605 include 'COMMON.INTERACT'
3606 include 'COMMON.DERIV'
3607 include 'COMMON.CHAIN'
3608 include 'COMMON.IOUNITS'
3609 include 'COMMON.NAMES'
3610 include 'COMMON.FFIELD'
3611 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3612 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3613 common /sccalc/ time11,time12,time112,theti,it,nlobit
3616 c write (iout,'(a)') 'ESC'
3617 do i=loc_start,loc_end
3620 if (it.eq.10) goto 1
3621 nlobit=nlob(iabs(it))
3622 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3623 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3624 theti=theta(i+1)-pipol
3628 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3630 if (x(2).gt.pi-delta) then
3634 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3636 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3637 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3639 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3640 & ddersc0(1),dersc(1))
3641 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3642 & ddersc0(3),dersc(3))
3644 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3646 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3647 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3648 & dersc0(2),esclocbi,dersc02)
3649 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3651 call splinthet(x(2),0.5d0*delta,ss,ssd)
3656 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3658 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3659 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3661 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3663 c write (iout,*) escloci
3664 else if (x(2).lt.delta) then
3668 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3670 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3671 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3673 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3674 & ddersc0(1),dersc(1))
3675 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3676 & ddersc0(3),dersc(3))
3678 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3680 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3681 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3682 & dersc0(2),esclocbi,dersc02)
3683 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3688 call splinthet(x(2),0.5d0*delta,ss,ssd)
3690 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3692 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3693 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3695 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3696 c write (iout,*) escloci
3698 call enesc(x,escloci,dersc,ddummy,.false.)
3701 escloc=escloc+escloci
3702 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3704 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3706 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3707 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3712 C---------------------------------------------------------------------------
3713 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3714 implicit real*8 (a-h,o-z)
3715 include 'DIMENSIONS'
3716 include 'COMMON.GEO'
3717 include 'COMMON.LOCAL'
3718 include 'COMMON.IOUNITS'
3719 common /sccalc/ time11,time12,time112,theti,it,nlobit
3720 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3721 double precision contr(maxlob,-1:1)
3723 c write (iout,*) 'it=',it,' nlobit=',nlobit
3727 if (mixed) ddersc(j)=0.0d0
3731 C Because of periodicity of the dependence of the SC energy in omega we have
3732 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3733 C To avoid underflows, first compute & store the exponents.
3741 z(k)=x(k)-censc(k,j,it)
3746 Axk=Axk+gaussc(l,k,j,it)*z(l)
3752 expfac=expfac+Ax(k,j,iii)*z(k)
3760 C As in the case of ebend, we want to avoid underflows in exponentiation and
3761 C subsequent NaNs and INFs in energy calculation.
3762 C Find the largest exponent
3766 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3770 cd print *,'it=',it,' emin=',emin
3772 C Compute the contribution to SC energy and derivatives
3776 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3777 cd print *,'j=',j,' expfac=',expfac
3778 escloc_i=escloc_i+expfac
3780 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3784 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3785 & +gaussc(k,2,j,it))*expfac
3792 dersc(1)=dersc(1)/cos(theti)**2
3793 ddersc(1)=ddersc(1)/cos(theti)**2
3796 escloci=-(dlog(escloc_i)-emin)
3798 dersc(j)=dersc(j)/escloc_i
3802 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3807 C------------------------------------------------------------------------------
3808 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3809 implicit real*8 (a-h,o-z)
3810 include 'DIMENSIONS'
3811 include 'COMMON.GEO'
3812 include 'COMMON.LOCAL'
3813 include 'COMMON.IOUNITS'
3814 common /sccalc/ time11,time12,time112,theti,it,nlobit
3815 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3816 double precision contr(maxlob)
3827 z(k)=x(k)-censc(k,j,it)
3833 Axk=Axk+gaussc(l,k,j,it)*z(l)
3839 expfac=expfac+Ax(k,j)*z(k)
3844 C As in the case of ebend, we want to avoid underflows in exponentiation and
3845 C subsequent NaNs and INFs in energy calculation.
3846 C Find the largest exponent
3849 if (emin.gt.contr(j)) emin=contr(j)
3853 C Compute the contribution to SC energy and derivatives
3857 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3858 escloc_i=escloc_i+expfac
3860 dersc(k)=dersc(k)+Ax(k,j)*expfac
3862 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3863 & +gaussc(1,2,j,it))*expfac
3867 dersc(1)=dersc(1)/cos(theti)**2
3868 dersc12=dersc12/cos(theti)**2
3869 escloci=-(dlog(escloc_i)-emin)
3871 dersc(j)=dersc(j)/escloc_i
3873 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3877 c----------------------------------------------------------------------------------
3878 subroutine esc(escloc)
3879 C Calculate the local energy of a side chain and its derivatives in the
3880 C corresponding virtual-bond valence angles THETA and the spherical angles
3881 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3882 C added by Urszula Kozlowska. 07/11/2007
3884 implicit real*8 (a-h,o-z)
3885 include 'DIMENSIONS'
3886 include 'DIMENSIONS.ZSCOPT'
3887 include 'COMMON.GEO'
3888 include 'COMMON.LOCAL'
3889 include 'COMMON.VAR'
3890 include 'COMMON.SCROT'
3891 include 'COMMON.INTERACT'
3892 include 'COMMON.DERIV'
3893 include 'COMMON.CHAIN'
3894 include 'COMMON.IOUNITS'
3895 include 'COMMON.NAMES'
3896 include 'COMMON.FFIELD'
3897 include 'COMMON.CONTROL'
3898 include 'COMMON.VECTORS'
3899 double precision x_prime(3),y_prime(3),z_prime(3)
3900 & , sumene,dsc_i,dp2_i,x(65),
3901 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3902 & de_dxx,de_dyy,de_dzz,de_dt
3903 double precision s1_t,s1_6_t,s2_t,s2_6_t
3905 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3906 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3907 & dt_dCi(3),dt_dCi1(3)
3908 common /sccalc/ time11,time12,time112,theti,it,nlobit
3911 do i=loc_start,loc_end
3912 if (itype(i).eq.21) cycle
3913 costtab(i+1) =dcos(theta(i+1))
3914 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3915 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3916 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3917 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3918 cosfac=dsqrt(cosfac2)
3919 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3920 sinfac=dsqrt(sinfac2)
3922 if (it.eq.10) goto 1
3924 C Compute the axes of tghe local cartesian coordinates system; store in
3925 c x_prime, y_prime and z_prime
3932 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3933 C & dc_norm(3,i+nres)
3935 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3936 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3939 z_prime(j) = -uz(j,i-1)
3942 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3943 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3944 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3945 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3946 c & " xy",scalar(x_prime(1),y_prime(1)),
3947 c & " xz",scalar(x_prime(1),z_prime(1)),
3948 c & " yy",scalar(y_prime(1),y_prime(1)),
3949 c & " yz",scalar(y_prime(1),z_prime(1)),
3950 c & " zz",scalar(z_prime(1),z_prime(1))
3952 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3953 C to local coordinate system. Store in xx, yy, zz.
3959 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3960 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3961 zz = zz + dsign(1.0,itype(i))*z_prime(j)*dc_norm(j,i+nres)
3968 C Compute the energy of the ith side cbain
3970 c write (2,*) "xx",xx," yy",yy," zz",zz
3973 x(j) = sc_parmin(j,it)
3976 Cc diagnostics - remove later
3978 yy1 = dsin(alph(2))*dcos(omeg(2))
3979 zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
3980 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3981 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3983 C," --- ", xx_w,yy_w,zz_w
3986 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3987 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3989 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3990 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3992 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3993 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3994 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3995 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3996 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3998 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3999 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4000 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4001 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4002 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4004 dsc_i = 0.743d0+x(61)
4006 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4007 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4008 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4009 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4010 s1=(1+x(63))/(0.1d0 + dscp1)
4011 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4012 s2=(1+x(65))/(0.1d0 + dscp2)
4013 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4014 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4015 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4016 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4018 c & dscp1,dscp2,sumene
4019 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4020 escloc = escloc + sumene
4021 c write (2,*) "escloc",escloc
4022 if (.not. calc_grad) goto 1
4025 C This section to check the numerical derivatives of the energy of ith side
4026 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4027 C #define DEBUG in the code to turn it on.
4029 write (2,*) "sumene =",sumene
4033 write (2,*) xx,yy,zz
4034 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4035 de_dxx_num=(sumenep-sumene)/aincr
4037 write (2,*) "xx+ sumene from enesc=",sumenep
4040 write (2,*) xx,yy,zz
4041 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4042 de_dyy_num=(sumenep-sumene)/aincr
4044 write (2,*) "yy+ sumene from enesc=",sumenep
4047 write (2,*) xx,yy,zz
4048 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4049 de_dzz_num=(sumenep-sumene)/aincr
4051 write (2,*) "zz+ sumene from enesc=",sumenep
4052 costsave=cost2tab(i+1)
4053 sintsave=sint2tab(i+1)
4054 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4055 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4056 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4057 de_dt_num=(sumenep-sumene)/aincr
4058 write (2,*) " t+ sumene from enesc=",sumenep
4059 cost2tab(i+1)=costsave
4060 sint2tab(i+1)=sintsave
4061 C End of diagnostics section.
4064 C Compute the gradient of esc
4066 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4067 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4068 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4069 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4070 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4071 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4072 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4073 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4074 pom1=(sumene3*sint2tab(i+1)+sumene1)
4075 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4076 pom2=(sumene4*cost2tab(i+1)+sumene2)
4077 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4078 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4079 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4080 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4082 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4083 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4084 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4086 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4087 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4088 & +(pom1+pom2)*pom_dx
4090 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4093 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4094 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4095 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4097 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4098 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4099 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4100 & +x(59)*zz**2 +x(60)*xx*zz
4101 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4102 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4103 & +(pom1-pom2)*pom_dy
4105 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4108 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4109 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4110 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4111 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4112 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4113 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4114 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4115 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4117 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4120 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4121 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4122 & +pom1*pom_dt1+pom2*pom_dt2
4124 write(2,*), "de_dt = ", de_dt,de_dt_num
4128 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4129 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4130 cosfac2xx=cosfac2*xx
4131 sinfac2yy=sinfac2*yy
4133 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4135 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4137 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4138 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4139 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4140 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4141 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4142 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4143 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4144 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4145 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4146 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4150 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4151 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4154 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4155 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4156 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4158 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4159 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4163 dXX_Ctab(k,i)=dXX_Ci(k)
4164 dXX_C1tab(k,i)=dXX_Ci1(k)
4165 dYY_Ctab(k,i)=dYY_Ci(k)
4166 dYY_C1tab(k,i)=dYY_Ci1(k)
4167 dZZ_Ctab(k,i)=dZZ_Ci(k)
4168 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4169 dXX_XYZtab(k,i)=dXX_XYZ(k)
4170 dYY_XYZtab(k,i)=dYY_XYZ(k)
4171 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4175 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4176 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4177 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4178 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4179 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4181 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4182 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4183 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4184 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4185 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4186 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4187 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4188 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4190 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4191 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4193 C to check gradient call subroutine check_grad
4200 c------------------------------------------------------------------------------
4201 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4203 C This procedure calculates two-body contact function g(rij) and its derivative:
4206 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4209 C where x=(rij-r0ij)/delta
4211 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4214 double precision rij,r0ij,eps0ij,fcont,fprimcont
4215 double precision x,x2,x4,delta
4219 if (x.lt.-1.0D0) then
4222 else if (x.le.1.0D0) then
4225 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4226 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4233 c------------------------------------------------------------------------------
4234 subroutine splinthet(theti,delta,ss,ssder)
4235 implicit real*8 (a-h,o-z)
4236 include 'DIMENSIONS'
4237 include 'DIMENSIONS.ZSCOPT'
4238 include 'COMMON.VAR'
4239 include 'COMMON.GEO'
4242 if (theti.gt.pipol) then
4243 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4245 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4250 c------------------------------------------------------------------------------
4251 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4253 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4254 double precision ksi,ksi2,ksi3,a1,a2,a3
4255 a1=fprim0*delta/(f1-f0)
4261 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4262 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4265 c------------------------------------------------------------------------------
4266 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4268 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4269 double precision ksi,ksi2,ksi3,a1,a2,a3
4274 a2=3*(f1x-f0x)-2*fprim0x*delta
4275 a3=fprim0x*delta-2*(f1x-f0x)
4276 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4279 C-----------------------------------------------------------------------------
4281 C-----------------------------------------------------------------------------
4282 subroutine etor(etors,edihcnstr,fact)
4283 implicit real*8 (a-h,o-z)
4284 include 'DIMENSIONS'
4285 include 'DIMENSIONS.ZSCOPT'
4286 include 'COMMON.VAR'
4287 include 'COMMON.GEO'
4288 include 'COMMON.LOCAL'
4289 include 'COMMON.TORSION'
4290 include 'COMMON.INTERACT'
4291 include 'COMMON.DERIV'
4292 include 'COMMON.CHAIN'
4293 include 'COMMON.NAMES'
4294 include 'COMMON.IOUNITS'
4295 include 'COMMON.FFIELD'
4296 include 'COMMON.TORCNSTR'
4298 C Set lprn=.true. for debugging
4302 do i=iphi_start,iphi_end
4303 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
4304 & .or. itype(i).eq.21) cycle
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 (itype(i-2).eq.21 .or. itype(i-1).eq.21
4389 & .or. itype(i).eq.21) cycle
4390 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4391 if (iabs(itype(i)).eq.20) then
4396 itori=itortyp(itype(i-2))
4397 itori1=itortyp(itype(i-1))
4400 C Regular cosine and sine terms
4401 do j=1,nterm(itori,itori1,iblock)
4402 v1ij=v1(j,itori,itori1,iblock)
4403 v2ij=v2(j,itori,itori1,iblock)
4406 etors=etors+v1ij*cosphi+v2ij*sinphi
4407 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4411 C E = SUM ----------------------------------- - v1
4412 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4414 cosphi=dcos(0.5d0*phii)
4415 sinphi=dsin(0.5d0*phii)
4416 do j=1,nlor(itori,itori1,iblock)
4417 vl1ij=vlor1(j,itori,itori1)
4418 vl2ij=vlor2(j,itori,itori1)
4419 vl3ij=vlor3(j,itori,itori1)
4420 pom=vl2ij*cosphi+vl3ij*sinphi
4421 pom1=1.0d0/(pom*pom+1.0d0)
4422 etors=etors+vl1ij*pom1
4423 c if (energy_dec) etors_ii=etors_ii+
4426 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4428 C Subtract the constant term
4429 etors=etors-v0(itori,itori1,iblock)
4431 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4432 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4433 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4434 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4435 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4438 ! 6/20/98 - dihedral angle constraints
4441 itori=idih_constr(i)
4443 difi=pinorm(phii-phi0(i))
4445 if (difi.gt.drange(i)) then
4447 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4448 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4449 edihi=0.25d0*ftors*difi**4
4450 else if (difi.lt.-drange(i)) then
4452 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4453 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4454 edihi=0.25d0*ftors*difi**4
4458 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4460 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4461 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4463 ! write (iout,*) 'edihcnstr',edihcnstr
4466 c----------------------------------------------------------------------------
4467 subroutine etor_d(etors_d,fact2)
4468 C 6/23/01 Compute double torsional energy
4469 implicit real*8 (a-h,o-z)
4470 include 'DIMENSIONS'
4471 include 'DIMENSIONS.ZSCOPT'
4472 include 'COMMON.VAR'
4473 include 'COMMON.GEO'
4474 include 'COMMON.LOCAL'
4475 include 'COMMON.TORSION'
4476 include 'COMMON.INTERACT'
4477 include 'COMMON.DERIV'
4478 include 'COMMON.CHAIN'
4479 include 'COMMON.NAMES'
4480 include 'COMMON.IOUNITS'
4481 include 'COMMON.FFIELD'
4482 include 'COMMON.TORCNSTR'
4484 C Set lprn=.true. for debugging
4488 do i=iphi_start,iphi_end-1
4489 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
4490 & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle
4491 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4493 itori=itortyp(itype(i-2))
4494 itori1=itortyp(itype(i-1))
4495 itori2=itortyp(itype(i))
4501 if (iabs(itype(i+1)).eq.20) iblock=2
4502 C Regular cosine and sine terms
4503 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4504 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4505 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4506 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4507 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4508 cosphi1=dcos(j*phii)
4509 sinphi1=dsin(j*phii)
4510 cosphi2=dcos(j*phii1)
4511 sinphi2=dsin(j*phii1)
4512 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4513 & v2cij*cosphi2+v2sij*sinphi2
4514 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4515 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4517 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4519 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4520 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4521 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4522 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4523 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4524 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4525 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4526 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4527 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4528 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4529 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4530 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4531 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4532 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4535 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4536 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4542 c------------------------------------------------------------------------------
4543 subroutine eback_sc_corr(esccor)
4544 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4545 c conformational states; temporarily implemented as differences
4546 c between UNRES torsional potentials (dependent on three types of
4547 c residues) and the torsional potentials dependent on all 20 types
4548 c of residues computed from AM1 energy surfaces of terminally-blocked
4549 c amino-acid residues.
4550 implicit real*8 (a-h,o-z)
4551 include 'DIMENSIONS'
4552 include 'DIMENSIONS.ZSCOPT'
4553 include 'COMMON.VAR'
4554 include 'COMMON.GEO'
4555 include 'COMMON.LOCAL'
4556 include 'COMMON.TORSION'
4557 include 'COMMON.SCCOR'
4558 include 'COMMON.INTERACT'
4559 include 'COMMON.DERIV'
4560 include 'COMMON.CHAIN'
4561 include 'COMMON.NAMES'
4562 include 'COMMON.IOUNITS'
4563 include 'COMMON.FFIELD'
4564 include 'COMMON.CONTROL'
4566 C Set lprn=.true. for debugging
4569 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4571 do i=iphi_start,iphi_end
4572 if (itype(i-2).eq.21 .or. itype(i-1).eq.21) cycle
4574 itori=iabs(itype(i-2))
4575 itori1=iabs(itype(i-1))
4579 v1ij=v1sccor(j,itori,itori1)
4580 v2ij=v2sccor(j,itori,itori1)
4583 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4584 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4587 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4588 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4589 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
4590 gsccor_loc(i-3)=gloci
4594 c------------------------------------------------------------------------------
4595 subroutine multibody(ecorr)
4596 C This subroutine calculates multi-body contributions to energy following
4597 C the idea of Skolnick et al. If side chains I and J make a contact and
4598 C at the same time side chains I+1 and J+1 make a contact, an extra
4599 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4600 implicit real*8 (a-h,o-z)
4601 include 'DIMENSIONS'
4602 include 'COMMON.IOUNITS'
4603 include 'COMMON.DERIV'
4604 include 'COMMON.INTERACT'
4605 include 'COMMON.CONTACTS'
4606 double precision gx(3),gx1(3)
4609 C Set lprn=.true. for debugging
4613 write (iout,'(a)') 'Contact function values:'
4615 write (iout,'(i2,20(1x,i2,f10.5))')
4616 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4631 num_conti=num_cont(i)
4632 num_conti1=num_cont(i1)
4637 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4638 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4639 cd & ' ishift=',ishift
4640 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4641 C The system gains extra energy.
4642 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4643 endif ! j1==j+-ishift
4652 c------------------------------------------------------------------------------
4653 double precision function esccorr(i,j,k,l,jj,kk)
4654 implicit real*8 (a-h,o-z)
4655 include 'DIMENSIONS'
4656 include 'COMMON.IOUNITS'
4657 include 'COMMON.DERIV'
4658 include 'COMMON.INTERACT'
4659 include 'COMMON.CONTACTS'
4660 double precision gx(3),gx1(3)
4665 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4666 C Calculate the multi-body contribution to energy.
4667 C Calculate multi-body contributions to the gradient.
4668 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4669 cd & k,l,(gacont(m,kk,k),m=1,3)
4671 gx(m) =ekl*gacont(m,jj,i)
4672 gx1(m)=eij*gacont(m,kk,k)
4673 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4674 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4675 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4676 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4680 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4685 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4691 c------------------------------------------------------------------------------
4693 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4694 implicit real*8 (a-h,o-z)
4695 include 'DIMENSIONS'
4696 integer dimen1,dimen2,atom,indx
4697 double precision buffer(dimen1,dimen2)
4698 double precision zapas
4699 common /contacts_hb/ zapas(3,20,maxres,7),
4700 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4701 & num_cont_hb(maxres),jcont_hb(20,maxres)
4702 num_kont=num_cont_hb(atom)
4706 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4709 buffer(i,indx+22)=facont_hb(i,atom)
4710 buffer(i,indx+23)=ees0p(i,atom)
4711 buffer(i,indx+24)=ees0m(i,atom)
4712 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4714 buffer(1,indx+26)=dfloat(num_kont)
4717 c------------------------------------------------------------------------------
4718 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4719 implicit real*8 (a-h,o-z)
4720 include 'DIMENSIONS'
4721 integer dimen1,dimen2,atom,indx
4722 double precision buffer(dimen1,dimen2)
4723 double precision zapas
4724 common /contacts_hb/ zapas(3,20,maxres,7),
4725 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4726 & num_cont_hb(maxres),jcont_hb(20,maxres)
4727 num_kont=buffer(1,indx+26)
4728 num_kont_old=num_cont_hb(atom)
4729 num_cont_hb(atom)=num_kont+num_kont_old
4734 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4737 facont_hb(ii,atom)=buffer(i,indx+22)
4738 ees0p(ii,atom)=buffer(i,indx+23)
4739 ees0m(ii,atom)=buffer(i,indx+24)
4740 jcont_hb(ii,atom)=buffer(i,indx+25)
4744 c------------------------------------------------------------------------------
4746 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4747 C This subroutine calculates multi-body contributions to hydrogen-bonding
4748 implicit real*8 (a-h,o-z)
4749 include 'DIMENSIONS'
4750 include 'DIMENSIONS.ZSCOPT'
4751 include 'COMMON.IOUNITS'
4753 include 'COMMON.INFO'
4755 include 'COMMON.FFIELD'
4756 include 'COMMON.DERIV'
4757 include 'COMMON.INTERACT'
4758 include 'COMMON.CONTACTS'
4760 parameter (max_cont=maxconts)
4761 parameter (max_dim=2*(8*3+2))
4762 parameter (msglen1=max_cont*max_dim*4)
4763 parameter (msglen2=2*msglen1)
4764 integer source,CorrelType,CorrelID,Error
4765 double precision buffer(max_cont,max_dim)
4767 double precision gx(3),gx1(3)
4770 C Set lprn=.true. for debugging
4775 if (fgProcs.le.1) goto 30
4777 write (iout,'(a)') 'Contact function values:'
4779 write (iout,'(2i3,50(1x,i2,f5.2))')
4780 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4781 & j=1,num_cont_hb(i))
4784 C Caution! Following code assumes that electrostatic interactions concerning
4785 C a given atom are split among at most two processors!
4795 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4798 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4799 if (MyRank.gt.0) then
4800 C Send correlation contributions to the preceding processor
4802 nn=num_cont_hb(iatel_s)
4803 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4804 cd write (iout,*) 'The BUFFER array:'
4806 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4808 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4810 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4811 C Clear the contacts of the atom passed to the neighboring processor
4812 nn=num_cont_hb(iatel_s+1)
4814 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4816 num_cont_hb(iatel_s)=0
4818 cd write (iout,*) 'Processor ',MyID,MyRank,
4819 cd & ' is sending correlation contribution to processor',MyID-1,
4820 cd & ' msglen=',msglen
4821 cd write (*,*) 'Processor ',MyID,MyRank,
4822 cd & ' is sending correlation contribution to processor',MyID-1,
4823 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4824 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4825 cd write (iout,*) 'Processor ',MyID,
4826 cd & ' has sent correlation contribution to processor',MyID-1,
4827 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4828 cd write (*,*) 'Processor ',MyID,
4829 cd & ' has sent correlation contribution to processor',MyID-1,
4830 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4832 endif ! (MyRank.gt.0)
4836 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4837 if (MyRank.lt.fgProcs-1) then
4838 C Receive correlation contributions from the next processor
4840 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4841 cd write (iout,*) 'Processor',MyID,
4842 cd & ' is receiving correlation contribution from processor',MyID+1,
4843 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4844 cd write (*,*) 'Processor',MyID,
4845 cd & ' is receiving correlation contribution from processor',MyID+1,
4846 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4848 do while (nbytes.le.0)
4849 call mp_probe(MyID+1,CorrelType,nbytes)
4851 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4852 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4853 cd write (iout,*) 'Processor',MyID,
4854 cd & ' has received correlation contribution from processor',MyID+1,
4855 cd & ' msglen=',msglen,' nbytes=',nbytes
4856 cd write (iout,*) 'The received BUFFER array:'
4858 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4860 if (msglen.eq.msglen1) then
4861 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4862 else if (msglen.eq.msglen2) then
4863 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4864 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4867 & 'ERROR!!!! message length changed while processing correlations.'
4869 & 'ERROR!!!! message length changed while processing correlations.'
4870 call mp_stopall(Error)
4871 endif ! msglen.eq.msglen1
4872 endif ! MyRank.lt.fgProcs-1
4879 write (iout,'(a)') 'Contact function values:'
4881 write (iout,'(2i3,50(1x,i2,f5.2))')
4882 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4883 & j=1,num_cont_hb(i))
4887 C Remove the loop below after debugging !!!
4894 C Calculate the local-electrostatic correlation terms
4895 do i=iatel_s,iatel_e+1
4897 num_conti=num_cont_hb(i)
4898 num_conti1=num_cont_hb(i+1)
4903 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4904 c & ' jj=',jj,' kk=',kk
4905 if (j1.eq.j+1 .or. j1.eq.j-1) then
4906 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4907 C The system gains extra energy.
4908 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4910 else if (j1.eq.j) then
4911 C Contacts I-J and I-(J+1) occur simultaneously.
4912 C The system loses extra energy.
4913 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4918 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4919 c & ' jj=',jj,' kk=',kk
4921 C Contacts I-J and (I+1)-J occur simultaneously.
4922 C The system loses extra energy.
4923 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4930 c------------------------------------------------------------------------------
4931 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4933 C This subroutine calculates multi-body contributions to hydrogen-bonding
4934 implicit real*8 (a-h,o-z)
4935 include 'DIMENSIONS'
4936 include 'DIMENSIONS.ZSCOPT'
4937 include 'COMMON.IOUNITS'
4939 include 'COMMON.INFO'
4941 include 'COMMON.FFIELD'
4942 include 'COMMON.DERIV'
4943 include 'COMMON.INTERACT'
4944 include 'COMMON.CONTACTS'
4946 parameter (max_cont=maxconts)
4947 parameter (max_dim=2*(8*3+2))
4948 parameter (msglen1=max_cont*max_dim*4)
4949 parameter (msglen2=2*msglen1)
4950 integer source,CorrelType,CorrelID,Error
4951 double precision buffer(max_cont,max_dim)
4953 double precision gx(3),gx1(3)
4956 C Set lprn=.true. for debugging
4962 if (fgProcs.le.1) goto 30
4964 write (iout,'(a)') 'Contact function values:'
4966 write (iout,'(2i3,50(1x,i2,f5.2))')
4967 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4968 & j=1,num_cont_hb(i))
4971 C Caution! Following code assumes that electrostatic interactions concerning
4972 C a given atom are split among at most two processors!
4982 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4985 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4986 if (MyRank.gt.0) then
4987 C Send correlation contributions to the preceding processor
4989 nn=num_cont_hb(iatel_s)
4990 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4991 cd write (iout,*) 'The BUFFER array:'
4993 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4995 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4997 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4998 C Clear the contacts of the atom passed to the neighboring processor
4999 nn=num_cont_hb(iatel_s+1)
5001 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5003 num_cont_hb(iatel_s)=0
5005 cd write (iout,*) 'Processor ',MyID,MyRank,
5006 cd & ' is sending correlation contribution to processor',MyID-1,
5007 cd & ' msglen=',msglen
5008 cd write (*,*) 'Processor ',MyID,MyRank,
5009 cd & ' is sending correlation contribution to processor',MyID-1,
5010 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5011 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5012 cd write (iout,*) 'Processor ',MyID,
5013 cd & ' has sent correlation contribution to processor',MyID-1,
5014 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5015 cd write (*,*) 'Processor ',MyID,
5016 cd & ' has sent correlation contribution to processor',MyID-1,
5017 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5019 endif ! (MyRank.gt.0)
5023 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5024 if (MyRank.lt.fgProcs-1) then
5025 C Receive correlation contributions from the next processor
5027 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5028 cd write (iout,*) 'Processor',MyID,
5029 cd & ' is receiving correlation contribution from processor',MyID+1,
5030 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5031 cd write (*,*) 'Processor',MyID,
5032 cd & ' is receiving correlation contribution from processor',MyID+1,
5033 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5035 do while (nbytes.le.0)
5036 call mp_probe(MyID+1,CorrelType,nbytes)
5038 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5039 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5040 cd write (iout,*) 'Processor',MyID,
5041 cd & ' has received correlation contribution from processor',MyID+1,
5042 cd & ' msglen=',msglen,' nbytes=',nbytes
5043 cd write (iout,*) 'The received BUFFER array:'
5045 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5047 if (msglen.eq.msglen1) then
5048 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5049 else if (msglen.eq.msglen2) then
5050 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5051 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5054 & 'ERROR!!!! message length changed while processing correlations.'
5056 & 'ERROR!!!! message length changed while processing correlations.'
5057 call mp_stopall(Error)
5058 endif ! msglen.eq.msglen1
5059 endif ! MyRank.lt.fgProcs-1
5066 write (iout,'(a)') 'Contact function values:'
5068 write (iout,'(2i3,50(1x,i2,f5.2))')
5069 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5070 & j=1,num_cont_hb(i))
5076 C Remove the loop below after debugging !!!
5083 C Calculate the dipole-dipole interaction energies
5084 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5085 do i=iatel_s,iatel_e+1
5086 num_conti=num_cont_hb(i)
5093 C Calculate the local-electrostatic correlation terms
5094 do i=iatel_s,iatel_e+1
5096 num_conti=num_cont_hb(i)
5097 num_conti1=num_cont_hb(i+1)
5102 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5103 c & ' jj=',jj,' kk=',kk
5104 if (j1.eq.j+1 .or. j1.eq.j-1) then
5105 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5106 C The system gains extra energy.
5108 sqd1=dsqrt(d_cont(jj,i))
5109 sqd2=dsqrt(d_cont(kk,i1))
5110 sred_geom = sqd1*sqd2
5111 IF (sred_geom.lt.cutoff_corr) THEN
5112 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5114 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5115 c & ' jj=',jj,' kk=',kk
5116 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5117 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5119 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5120 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5123 cd write (iout,*) 'sred_geom=',sred_geom,
5124 cd & ' ekont=',ekont,' fprim=',fprimcont
5125 call calc_eello(i,j,i+1,j1,jj,kk)
5126 if (wcorr4.gt.0.0d0)
5127 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5128 if (wcorr5.gt.0.0d0)
5129 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5130 c print *,"wcorr5",ecorr5
5131 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5132 cd write(2,*)'ijkl',i,j,i+1,j1
5133 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5134 & .or. wturn6.eq.0.0d0))then
5135 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5136 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5137 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5138 cd & 'ecorr6=',ecorr6
5139 cd write (iout,'(4e15.5)') sred_geom,
5140 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5141 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5142 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5143 else if (wturn6.gt.0.0d0
5144 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5145 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5146 eturn6=eturn6+eello_turn6(i,jj,kk)
5147 cd write (2,*) 'multibody_eello:eturn6',eturn6
5151 else if (j1.eq.j) then
5152 C Contacts I-J and I-(J+1) occur simultaneously.
5153 C The system loses extra energy.
5154 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5159 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5160 c & ' jj=',jj,' kk=',kk
5162 C Contacts I-J and (I+1)-J occur simultaneously.
5163 C The system loses extra energy.
5164 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5171 c------------------------------------------------------------------------------
5172 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5173 implicit real*8 (a-h,o-z)
5174 include 'DIMENSIONS'
5175 include 'COMMON.IOUNITS'
5176 include 'COMMON.DERIV'
5177 include 'COMMON.INTERACT'
5178 include 'COMMON.CONTACTS'
5179 double precision gx(3),gx1(3)
5189 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5190 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5191 C Following 4 lines for diagnostics.
5196 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5198 c write (iout,*)'Contacts have occurred for peptide groups',
5199 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5200 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5201 C Calculate the multi-body contribution to energy.
5202 ecorr=ecorr+ekont*ees
5204 C Calculate multi-body contributions to the gradient.
5206 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5207 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5208 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5209 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5210 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5211 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5212 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5213 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5214 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5215 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5216 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5217 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5218 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5219 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5223 gradcorr(ll,m)=gradcorr(ll,m)+
5224 & ees*ekl*gacont_hbr(ll,jj,i)-
5225 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5226 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5231 gradcorr(ll,m)=gradcorr(ll,m)+
5232 & ees*eij*gacont_hbr(ll,kk,k)-
5233 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5234 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5241 C---------------------------------------------------------------------------
5242 subroutine dipole(i,j,jj)
5243 implicit real*8 (a-h,o-z)
5244 include 'DIMENSIONS'
5245 include 'DIMENSIONS.ZSCOPT'
5246 include 'COMMON.IOUNITS'
5247 include 'COMMON.CHAIN'
5248 include 'COMMON.FFIELD'
5249 include 'COMMON.DERIV'
5250 include 'COMMON.INTERACT'
5251 include 'COMMON.CONTACTS'
5252 include 'COMMON.TORSION'
5253 include 'COMMON.VAR'
5254 include 'COMMON.GEO'
5255 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5257 iti1 = itortyp(itype(i+1))
5258 if (j.lt.nres-1) then
5259 if (itype(j).le.ntyp) then
5260 itj1 = itortyp(itype(j+1))
5268 dipi(iii,1)=Ub2(iii,i)
5269 dipderi(iii)=Ub2der(iii,i)
5270 dipi(iii,2)=b1(iii,iti1)
5271 dipj(iii,1)=Ub2(iii,j)
5272 dipderj(iii)=Ub2der(iii,j)
5273 dipj(iii,2)=b1(iii,itj1)
5277 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5280 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5283 if (.not.calc_grad) return
5288 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5292 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5297 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5298 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5300 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5302 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5304 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5308 C---------------------------------------------------------------------------
5309 subroutine calc_eello(i,j,k,l,jj,kk)
5311 C This subroutine computes matrices and vectors needed to calculate
5312 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5314 implicit real*8 (a-h,o-z)
5315 include 'DIMENSIONS'
5316 include 'DIMENSIONS.ZSCOPT'
5317 include 'COMMON.IOUNITS'
5318 include 'COMMON.CHAIN'
5319 include 'COMMON.DERIV'
5320 include 'COMMON.INTERACT'
5321 include 'COMMON.CONTACTS'
5322 include 'COMMON.TORSION'
5323 include 'COMMON.VAR'
5324 include 'COMMON.GEO'
5325 include 'COMMON.FFIELD'
5326 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5327 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5330 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5331 cd & ' jj=',jj,' kk=',kk
5332 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5335 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5336 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5339 call transpose2(aa1(1,1),aa1t(1,1))
5340 call transpose2(aa2(1,1),aa2t(1,1))
5343 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5344 & aa1tder(1,1,lll,kkk))
5345 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5346 & aa2tder(1,1,lll,kkk))
5350 C parallel orientation of the two CA-CA-CA frames.
5351 if (i.gt.1 .and. itype(i).le.ntyp) then
5352 iti=itortyp(itype(i))
5356 itk1=itortyp(itype(k+1))
5357 itj=itortyp(itype(j))
5358 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5359 itl1=itortyp(itype(l+1))
5363 C A1 kernel(j+1) A2T
5365 cd write (iout,'(3f10.5,5x,3f10.5)')
5366 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5368 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5369 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5370 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5371 C Following matrices are needed only for 6-th order cumulants
5372 IF (wcorr6.gt.0.0d0) THEN
5373 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5374 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5375 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5376 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5377 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5378 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5379 & ADtEAderx(1,1,1,1,1,1))
5381 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5382 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5383 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5384 & ADtEA1derx(1,1,1,1,1,1))
5386 C End 6-th order cumulants
5389 cd write (2,*) 'In calc_eello6'
5391 cd write (2,*) 'iii=',iii
5393 cd write (2,*) 'kkk=',kkk
5395 cd write (2,'(3(2f10.5),5x)')
5396 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5401 call transpose2(EUgder(1,1,k),auxmat(1,1))
5402 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5403 call transpose2(EUg(1,1,k),auxmat(1,1))
5404 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5405 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5409 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5410 & EAEAderx(1,1,lll,kkk,iii,1))
5414 C A1T kernel(i+1) A2
5415 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5416 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5417 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5418 C Following matrices are needed only for 6-th order cumulants
5419 IF (wcorr6.gt.0.0d0) THEN
5420 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5421 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5422 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5423 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5424 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5425 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5426 & ADtEAderx(1,1,1,1,1,2))
5427 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5428 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5429 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5430 & ADtEA1derx(1,1,1,1,1,2))
5432 C End 6-th order cumulants
5433 call transpose2(EUgder(1,1,l),auxmat(1,1))
5434 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5435 call transpose2(EUg(1,1,l),auxmat(1,1))
5436 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5437 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5441 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5442 & EAEAderx(1,1,lll,kkk,iii,2))
5447 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5448 C They are needed only when the fifth- or the sixth-order cumulants are
5450 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5451 call transpose2(AEA(1,1,1),auxmat(1,1))
5452 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5453 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5454 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5455 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5456 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5457 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5458 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5459 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5460 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5461 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5462 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5463 call transpose2(AEA(1,1,2),auxmat(1,1))
5464 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5465 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5466 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5467 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5468 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5469 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5470 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5471 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5472 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5473 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5474 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5475 C Calculate the Cartesian derivatives of the vectors.
5479 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5480 call matvec2(auxmat(1,1),b1(1,iti),
5481 & AEAb1derx(1,lll,kkk,iii,1,1))
5482 call matvec2(auxmat(1,1),Ub2(1,i),
5483 & AEAb2derx(1,lll,kkk,iii,1,1))
5484 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5485 & AEAb1derx(1,lll,kkk,iii,2,1))
5486 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5487 & AEAb2derx(1,lll,kkk,iii,2,1))
5488 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5489 call matvec2(auxmat(1,1),b1(1,itj),
5490 & AEAb1derx(1,lll,kkk,iii,1,2))
5491 call matvec2(auxmat(1,1),Ub2(1,j),
5492 & AEAb2derx(1,lll,kkk,iii,1,2))
5493 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5494 & AEAb1derx(1,lll,kkk,iii,2,2))
5495 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5496 & AEAb2derx(1,lll,kkk,iii,2,2))
5503 C Antiparallel orientation of the two CA-CA-CA frames.
5504 if (i.gt.1 .and. itype(i).le.ntyp) then
5505 iti=itortyp(itype(i))
5509 itk1=itortyp(itype(k+1))
5510 itl=itortyp(itype(l))
5511 itj=itortyp(itype(j))
5512 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5513 itj1=itortyp(itype(j+1))
5517 C A2 kernel(j-1)T A1T
5518 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5519 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5520 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5521 C Following matrices are needed only for 6-th order cumulants
5522 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5523 & j.eq.i+4 .and. l.eq.i+3)) THEN
5524 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5525 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5526 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5527 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5528 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5529 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5530 & ADtEAderx(1,1,1,1,1,1))
5531 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5532 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5533 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5534 & ADtEA1derx(1,1,1,1,1,1))
5536 C End 6-th order cumulants
5537 call transpose2(EUgder(1,1,k),auxmat(1,1))
5538 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5539 call transpose2(EUg(1,1,k),auxmat(1,1))
5540 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5541 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5545 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5546 & EAEAderx(1,1,lll,kkk,iii,1))
5550 C A2T kernel(i+1)T A1
5551 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5552 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5553 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5554 C Following matrices are needed only for 6-th order cumulants
5555 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5556 & j.eq.i+4 .and. l.eq.i+3)) THEN
5557 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5558 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5559 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5560 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5561 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5562 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5563 & ADtEAderx(1,1,1,1,1,2))
5564 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5565 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5566 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5567 & ADtEA1derx(1,1,1,1,1,2))
5569 C End 6-th order cumulants
5570 call transpose2(EUgder(1,1,j),auxmat(1,1))
5571 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5572 call transpose2(EUg(1,1,j),auxmat(1,1))
5573 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5574 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5578 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5579 & EAEAderx(1,1,lll,kkk,iii,2))
5584 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5585 C They are needed only when the fifth- or the sixth-order cumulants are
5587 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5588 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5589 call transpose2(AEA(1,1,1),auxmat(1,1))
5590 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5591 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5592 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5593 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5594 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5595 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5596 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5597 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5598 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5599 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5600 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5601 call transpose2(AEA(1,1,2),auxmat(1,1))
5602 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5603 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5604 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5605 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5606 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5607 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5608 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5609 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5610 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5611 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5612 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5613 C Calculate the Cartesian derivatives of the vectors.
5617 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5618 call matvec2(auxmat(1,1),b1(1,iti),
5619 & AEAb1derx(1,lll,kkk,iii,1,1))
5620 call matvec2(auxmat(1,1),Ub2(1,i),
5621 & AEAb2derx(1,lll,kkk,iii,1,1))
5622 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5623 & AEAb1derx(1,lll,kkk,iii,2,1))
5624 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5625 & AEAb2derx(1,lll,kkk,iii,2,1))
5626 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5627 call matvec2(auxmat(1,1),b1(1,itl),
5628 & AEAb1derx(1,lll,kkk,iii,1,2))
5629 call matvec2(auxmat(1,1),Ub2(1,l),
5630 & AEAb2derx(1,lll,kkk,iii,1,2))
5631 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5632 & AEAb1derx(1,lll,kkk,iii,2,2))
5633 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5634 & AEAb2derx(1,lll,kkk,iii,2,2))
5643 C---------------------------------------------------------------------------
5644 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5645 & KK,KKderg,AKA,AKAderg,AKAderx)
5649 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5650 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5651 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5656 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5658 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5661 cd if (lprn) write (2,*) 'In kernel'
5663 cd if (lprn) write (2,*) 'kkk=',kkk
5665 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5666 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5668 cd write (2,*) 'lll=',lll
5669 cd write (2,*) 'iii=1'
5671 cd write (2,'(3(2f10.5),5x)')
5672 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5675 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5676 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5678 cd write (2,*) 'lll=',lll
5679 cd write (2,*) 'iii=2'
5681 cd write (2,'(3(2f10.5),5x)')
5682 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5689 C---------------------------------------------------------------------------
5690 double precision function eello4(i,j,k,l,jj,kk)
5691 implicit real*8 (a-h,o-z)
5692 include 'DIMENSIONS'
5693 include 'DIMENSIONS.ZSCOPT'
5694 include 'COMMON.IOUNITS'
5695 include 'COMMON.CHAIN'
5696 include 'COMMON.DERIV'
5697 include 'COMMON.INTERACT'
5698 include 'COMMON.CONTACTS'
5699 include 'COMMON.TORSION'
5700 include 'COMMON.VAR'
5701 include 'COMMON.GEO'
5702 double precision pizda(2,2),ggg1(3),ggg2(3)
5703 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5707 cd print *,'eello4:',i,j,k,l,jj,kk
5708 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5709 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5710 cold eij=facont_hb(jj,i)
5711 cold ekl=facont_hb(kk,k)
5713 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5715 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5716 gcorr_loc(k-1)=gcorr_loc(k-1)
5717 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5719 gcorr_loc(l-1)=gcorr_loc(l-1)
5720 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5722 gcorr_loc(j-1)=gcorr_loc(j-1)
5723 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5728 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5729 & -EAEAderx(2,2,lll,kkk,iii,1)
5730 cd derx(lll,kkk,iii)=0.0d0
5734 cd gcorr_loc(l-1)=0.0d0
5735 cd gcorr_loc(j-1)=0.0d0
5736 cd gcorr_loc(k-1)=0.0d0
5738 cd write (iout,*)'Contacts have occurred for peptide groups',
5739 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5740 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5741 if (j.lt.nres-1) then
5748 if (l.lt.nres-1) then
5756 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5757 ggg1(ll)=eel4*g_contij(ll,1)
5758 ggg2(ll)=eel4*g_contij(ll,2)
5759 ghalf=0.5d0*ggg1(ll)
5761 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5762 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5763 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5764 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5765 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5766 ghalf=0.5d0*ggg2(ll)
5768 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5769 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5770 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5771 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5776 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5777 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5782 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5783 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5789 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5794 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5798 cd write (2,*) iii,gcorr_loc(iii)
5802 cd write (2,*) 'ekont',ekont
5803 cd write (iout,*) 'eello4',ekont*eel4
5806 C---------------------------------------------------------------------------
5807 double precision function eello5(i,j,k,l,jj,kk)
5808 implicit real*8 (a-h,o-z)
5809 include 'DIMENSIONS'
5810 include 'DIMENSIONS.ZSCOPT'
5811 include 'COMMON.IOUNITS'
5812 include 'COMMON.CHAIN'
5813 include 'COMMON.DERIV'
5814 include 'COMMON.INTERACT'
5815 include 'COMMON.CONTACTS'
5816 include 'COMMON.TORSION'
5817 include 'COMMON.VAR'
5818 include 'COMMON.GEO'
5819 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5820 double precision ggg1(3),ggg2(3)
5821 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5826 C /l\ / \ \ / \ / \ / C
5827 C / \ / \ \ / \ / \ / C
5828 C j| o |l1 | o | o| o | | o |o C
5829 C \ |/k\| |/ \| / |/ \| |/ \| C
5830 C \i/ \ / \ / / \ / \ C
5832 C (I) (II) (III) (IV) C
5834 C eello5_1 eello5_2 eello5_3 eello5_4 C
5836 C Antiparallel chains C
5839 C /j\ / \ \ / \ / \ / C
5840 C / \ / \ \ / \ / \ / C
5841 C j1| o |l | 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 o denotes a local interaction, vertical lines an electrostatic interaction. C
5851 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5852 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5857 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5859 itk=itortyp(itype(k))
5860 itl=itortyp(itype(l))
5861 itj=itortyp(itype(j))
5866 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5867 cd & eel5_3_num,eel5_4_num)
5871 derx(lll,kkk,iii)=0.0d0
5875 cd eij=facont_hb(jj,i)
5876 cd ekl=facont_hb(kk,k)
5878 cd write (iout,*)'Contacts have occurred for peptide groups',
5879 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5881 C Contribution from the graph I.
5882 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5883 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5884 call transpose2(EUg(1,1,k),auxmat(1,1))
5885 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5886 vv(1)=pizda(1,1)-pizda(2,2)
5887 vv(2)=pizda(1,2)+pizda(2,1)
5888 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5889 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5891 C Explicit gradient in virtual-dihedral angles.
5892 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5893 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5894 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5895 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5896 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5897 vv(1)=pizda(1,1)-pizda(2,2)
5898 vv(2)=pizda(1,2)+pizda(2,1)
5899 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5900 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5901 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5902 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5903 vv(1)=pizda(1,1)-pizda(2,2)
5904 vv(2)=pizda(1,2)+pizda(2,1)
5906 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5907 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5908 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5910 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5911 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5912 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5914 C Cartesian gradient
5918 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5920 vv(1)=pizda(1,1)-pizda(2,2)
5921 vv(2)=pizda(1,2)+pizda(2,1)
5922 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5923 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5924 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5931 C Contribution from graph II
5932 call transpose2(EE(1,1,itk),auxmat(1,1))
5933 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5934 vv(1)=pizda(1,1)+pizda(2,2)
5935 vv(2)=pizda(2,1)-pizda(1,2)
5936 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5937 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5939 C Explicit gradient in virtual-dihedral angles.
5940 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5941 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5942 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5943 vv(1)=pizda(1,1)+pizda(2,2)
5944 vv(2)=pizda(2,1)-pizda(1,2)
5946 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5947 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5948 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5950 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5951 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5952 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5954 C Cartesian gradient
5958 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5960 vv(1)=pizda(1,1)+pizda(2,2)
5961 vv(2)=pizda(2,1)-pizda(1,2)
5962 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5963 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5964 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5973 C Parallel orientation
5974 C Contribution from graph III
5975 call transpose2(EUg(1,1,l),auxmat(1,1))
5976 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5977 vv(1)=pizda(1,1)-pizda(2,2)
5978 vv(2)=pizda(1,2)+pizda(2,1)
5979 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5980 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5982 C Explicit gradient in virtual-dihedral angles.
5983 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5984 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5985 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5986 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5987 vv(1)=pizda(1,1)-pizda(2,2)
5988 vv(2)=pizda(1,2)+pizda(2,1)
5989 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5990 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5991 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5992 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5993 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5994 vv(1)=pizda(1,1)-pizda(2,2)
5995 vv(2)=pizda(1,2)+pizda(2,1)
5996 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5997 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5998 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5999 C Cartesian gradient
6003 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6005 vv(1)=pizda(1,1)-pizda(2,2)
6006 vv(2)=pizda(1,2)+pizda(2,1)
6007 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6008 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6009 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6015 C Contribution from graph IV
6017 call transpose2(EE(1,1,itl),auxmat(1,1))
6018 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6019 vv(1)=pizda(1,1)+pizda(2,2)
6020 vv(2)=pizda(2,1)-pizda(1,2)
6021 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6022 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6024 C Explicit gradient in virtual-dihedral angles.
6025 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6026 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6027 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6028 vv(1)=pizda(1,1)+pizda(2,2)
6029 vv(2)=pizda(2,1)-pizda(1,2)
6030 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6031 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6032 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6033 C Cartesian gradient
6037 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6039 vv(1)=pizda(1,1)+pizda(2,2)
6040 vv(2)=pizda(2,1)-pizda(1,2)
6041 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6042 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6043 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6049 C Antiparallel orientation
6050 C Contribution from graph III
6052 call transpose2(EUg(1,1,j),auxmat(1,1))
6053 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6054 vv(1)=pizda(1,1)-pizda(2,2)
6055 vv(2)=pizda(1,2)+pizda(2,1)
6056 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6057 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6059 C Explicit gradient in virtual-dihedral angles.
6060 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6061 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6062 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6063 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6064 vv(1)=pizda(1,1)-pizda(2,2)
6065 vv(2)=pizda(1,2)+pizda(2,1)
6066 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6067 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6068 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6069 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6070 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6071 vv(1)=pizda(1,1)-pizda(2,2)
6072 vv(2)=pizda(1,2)+pizda(2,1)
6073 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6074 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6075 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6076 C Cartesian gradient
6080 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6082 vv(1)=pizda(1,1)-pizda(2,2)
6083 vv(2)=pizda(1,2)+pizda(2,1)
6084 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6085 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6086 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6092 C Contribution from graph IV
6094 call transpose2(EE(1,1,itj),auxmat(1,1))
6095 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6096 vv(1)=pizda(1,1)+pizda(2,2)
6097 vv(2)=pizda(2,1)-pizda(1,2)
6098 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6099 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6101 C Explicit gradient in virtual-dihedral angles.
6102 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6103 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6104 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6105 vv(1)=pizda(1,1)+pizda(2,2)
6106 vv(2)=pizda(2,1)-pizda(1,2)
6107 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6108 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6109 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6110 C Cartesian gradient
6114 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6116 vv(1)=pizda(1,1)+pizda(2,2)
6117 vv(2)=pizda(2,1)-pizda(1,2)
6118 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6119 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6120 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6127 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6128 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6129 cd write (2,*) 'ijkl',i,j,k,l
6130 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6131 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6133 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6134 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6135 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6136 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6138 if (j.lt.nres-1) then
6145 if (l.lt.nres-1) then
6155 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6157 ggg1(ll)=eel5*g_contij(ll,1)
6158 ggg2(ll)=eel5*g_contij(ll,2)
6159 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6160 ghalf=0.5d0*ggg1(ll)
6162 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6163 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6164 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6165 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6166 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6167 ghalf=0.5d0*ggg2(ll)
6169 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6170 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6171 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6172 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6177 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6178 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6183 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6184 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6190 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6195 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6199 cd write (2,*) iii,g_corr5_loc(iii)
6203 cd write (2,*) 'ekont',ekont
6204 cd write (iout,*) 'eello5',ekont*eel5
6207 c--------------------------------------------------------------------------
6208 double precision function eello6(i,j,k,l,jj,kk)
6209 implicit real*8 (a-h,o-z)
6210 include 'DIMENSIONS'
6211 include 'DIMENSIONS.ZSCOPT'
6212 include 'COMMON.IOUNITS'
6213 include 'COMMON.CHAIN'
6214 include 'COMMON.DERIV'
6215 include 'COMMON.INTERACT'
6216 include 'COMMON.CONTACTS'
6217 include 'COMMON.TORSION'
6218 include 'COMMON.VAR'
6219 include 'COMMON.GEO'
6220 include 'COMMON.FFIELD'
6221 double precision ggg1(3),ggg2(3)
6222 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6227 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6235 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6236 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6240 derx(lll,kkk,iii)=0.0d0
6244 cd eij=facont_hb(jj,i)
6245 cd ekl=facont_hb(kk,k)
6251 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6252 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6253 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6254 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6255 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6256 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6258 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6259 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6260 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6261 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6262 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6263 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6267 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6269 C If turn contributions are considered, they will be handled separately.
6270 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6271 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6272 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6273 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6274 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6275 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6276 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6279 if (j.lt.nres-1) then
6286 if (l.lt.nres-1) then
6294 ggg1(ll)=eel6*g_contij(ll,1)
6295 ggg2(ll)=eel6*g_contij(ll,2)
6296 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6297 ghalf=0.5d0*ggg1(ll)
6299 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6300 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6301 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6302 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6303 ghalf=0.5d0*ggg2(ll)
6304 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6306 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6307 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6308 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6309 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6314 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6315 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6320 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6321 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6327 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6332 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6336 cd write (2,*) iii,g_corr6_loc(iii)
6340 cd write (2,*) 'ekont',ekont
6341 cd write (iout,*) 'eello6',ekont*eel6
6344 c--------------------------------------------------------------------------
6345 double precision function eello6_graph1(i,j,k,l,imat,swap)
6346 implicit real*8 (a-h,o-z)
6347 include 'DIMENSIONS'
6348 include 'DIMENSIONS.ZSCOPT'
6349 include 'COMMON.IOUNITS'
6350 include 'COMMON.CHAIN'
6351 include 'COMMON.DERIV'
6352 include 'COMMON.INTERACT'
6353 include 'COMMON.CONTACTS'
6354 include 'COMMON.TORSION'
6355 include 'COMMON.VAR'
6356 include 'COMMON.GEO'
6357 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6361 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6363 C Parallel Antiparallel C
6369 C \ j|/k\| / \ |/k\|l / C
6374 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6375 itk=itortyp(itype(k))
6376 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6377 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6378 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6379 call transpose2(EUgC(1,1,k),auxmat(1,1))
6380 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6381 vv1(1)=pizda1(1,1)-pizda1(2,2)
6382 vv1(2)=pizda1(1,2)+pizda1(2,1)
6383 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6384 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6385 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6386 s5=scalar2(vv(1),Dtobr2(1,i))
6387 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6388 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6389 if (.not. calc_grad) return
6390 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6391 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6392 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6393 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6394 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6395 & +scalar2(vv(1),Dtobr2der(1,i)))
6396 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6397 vv1(1)=pizda1(1,1)-pizda1(2,2)
6398 vv1(2)=pizda1(1,2)+pizda1(2,1)
6399 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6400 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6402 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6403 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6404 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6405 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6406 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6408 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6409 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6410 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6411 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6412 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6414 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6415 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6416 vv1(1)=pizda1(1,1)-pizda1(2,2)
6417 vv1(2)=pizda1(1,2)+pizda1(2,1)
6418 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6419 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6420 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6421 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6430 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6431 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6432 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6433 call transpose2(EUgC(1,1,k),auxmat(1,1))
6434 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6436 vv1(1)=pizda1(1,1)-pizda1(2,2)
6437 vv1(2)=pizda1(1,2)+pizda1(2,1)
6438 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6439 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6440 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6441 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6442 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6443 s5=scalar2(vv(1),Dtobr2(1,i))
6444 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6450 c----------------------------------------------------------------------------
6451 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6452 implicit real*8 (a-h,o-z)
6453 include 'DIMENSIONS'
6454 include 'DIMENSIONS.ZSCOPT'
6455 include 'COMMON.IOUNITS'
6456 include 'COMMON.CHAIN'
6457 include 'COMMON.DERIV'
6458 include 'COMMON.INTERACT'
6459 include 'COMMON.CONTACTS'
6460 include 'COMMON.TORSION'
6461 include 'COMMON.VAR'
6462 include 'COMMON.GEO'
6464 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6465 & auxvec1(2),auxvec2(1),auxmat1(2,2)
6468 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6470 C Parallel Antiparallel C
6476 C \ j|/k\| \ |/k\|l C
6481 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6482 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6483 C AL 7/4/01 s1 would occur in the sixth-order moment,
6484 C but not in a cluster cumulant
6486 s1=dip(1,jj,i)*dip(1,kk,k)
6488 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6489 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6490 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6491 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6492 call transpose2(EUg(1,1,k),auxmat(1,1))
6493 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6494 vv(1)=pizda(1,1)-pizda(2,2)
6495 vv(2)=pizda(1,2)+pizda(2,1)
6496 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6497 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6499 eello6_graph2=-(s1+s2+s3+s4)
6501 eello6_graph2=-(s2+s3+s4)
6504 if (.not. calc_grad) return
6505 C Derivatives in gamma(i-1)
6508 s1=dipderg(1,jj,i)*dip(1,kk,k)
6510 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6511 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6512 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6513 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6515 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6517 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6519 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6521 C Derivatives in gamma(k-1)
6523 s1=dip(1,jj,i)*dipderg(1,kk,k)
6525 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6526 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6527 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6528 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6529 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6530 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6531 vv(1)=pizda(1,1)-pizda(2,2)
6532 vv(2)=pizda(1,2)+pizda(2,1)
6533 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6535 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6537 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6539 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6540 C Derivatives in gamma(j-1) or gamma(l-1)
6543 s1=dipderg(3,jj,i)*dip(1,kk,k)
6545 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6546 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6547 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6548 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6549 vv(1)=pizda(1,1)-pizda(2,2)
6550 vv(2)=pizda(1,2)+pizda(2,1)
6551 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6554 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6556 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6559 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6560 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6562 C Derivatives in gamma(l-1) or gamma(j-1)
6565 s1=dip(1,jj,i)*dipderg(3,kk,k)
6567 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6568 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6569 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6570 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6571 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6572 vv(1)=pizda(1,1)-pizda(2,2)
6573 vv(2)=pizda(1,2)+pizda(2,1)
6574 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6577 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6579 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6582 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6583 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6585 C Cartesian derivatives.
6587 write (2,*) 'In eello6_graph2'
6589 write (2,*) 'iii=',iii
6591 write (2,*) 'kkk=',kkk
6593 write (2,'(3(2f10.5),5x)')
6594 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6604 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6606 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6609 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6611 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6612 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6614 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6615 call transpose2(EUg(1,1,k),auxmat(1,1))
6616 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6618 vv(1)=pizda(1,1)-pizda(2,2)
6619 vv(2)=pizda(1,2)+pizda(2,1)
6620 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6621 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6623 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6625 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6628 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6630 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6637 c----------------------------------------------------------------------------
6638 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6639 implicit real*8 (a-h,o-z)
6640 include 'DIMENSIONS'
6641 include 'DIMENSIONS.ZSCOPT'
6642 include 'COMMON.IOUNITS'
6643 include 'COMMON.CHAIN'
6644 include 'COMMON.DERIV'
6645 include 'COMMON.INTERACT'
6646 include 'COMMON.CONTACTS'
6647 include 'COMMON.TORSION'
6648 include 'COMMON.VAR'
6649 include 'COMMON.GEO'
6650 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6652 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6654 C Parallel Antiparallel C
6660 C j|/k\| / |/k\|l / C
6665 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6667 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6668 C energy moment and not to the cluster cumulant.
6669 iti=itortyp(itype(i))
6670 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6671 itj1=itortyp(itype(j+1))
6675 itk=itortyp(itype(k))
6676 itk1=itortyp(itype(k+1))
6677 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6678 itl1=itortyp(itype(l+1))
6683 s1=dip(4,jj,i)*dip(4,kk,k)
6685 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6686 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6687 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6688 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6689 call transpose2(EE(1,1,itk),auxmat(1,1))
6690 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6691 vv(1)=pizda(1,1)+pizda(2,2)
6692 vv(2)=pizda(2,1)-pizda(1,2)
6693 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6694 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6696 eello6_graph3=-(s1+s2+s3+s4)
6698 eello6_graph3=-(s2+s3+s4)
6701 if (.not. calc_grad) return
6702 C Derivatives in gamma(k-1)
6703 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6704 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6705 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6706 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6707 C Derivatives in gamma(l-1)
6708 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6709 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6710 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6711 vv(1)=pizda(1,1)+pizda(2,2)
6712 vv(2)=pizda(2,1)-pizda(1,2)
6713 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6714 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6715 C Cartesian derivatives.
6721 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6723 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6726 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6728 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6729 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6731 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6732 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6734 vv(1)=pizda(1,1)+pizda(2,2)
6735 vv(2)=pizda(2,1)-pizda(1,2)
6736 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6738 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6740 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6743 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6745 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6747 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6753 c----------------------------------------------------------------------------
6754 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6755 implicit real*8 (a-h,o-z)
6756 include 'DIMENSIONS'
6757 include 'DIMENSIONS.ZSCOPT'
6758 include 'COMMON.IOUNITS'
6759 include 'COMMON.CHAIN'
6760 include 'COMMON.DERIV'
6761 include 'COMMON.INTERACT'
6762 include 'COMMON.CONTACTS'
6763 include 'COMMON.TORSION'
6764 include 'COMMON.VAR'
6765 include 'COMMON.GEO'
6766 include 'COMMON.FFIELD'
6767 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6768 & auxvec1(2),auxmat1(2,2)
6770 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6772 C Parallel Antiparallel C
6778 C \ j|/k\| \ |/k\|l C
6783 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6785 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6786 C energy moment and not to the cluster cumulant.
6787 cd write (2,*) 'eello_graph4: wturn6',wturn6
6788 iti=itortyp(itype(i))
6789 itj=itortyp(itype(j))
6790 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6791 itj1=itortyp(itype(j+1))
6795 itk=itortyp(itype(k))
6796 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6797 itk1=itortyp(itype(k+1))
6801 itl=itortyp(itype(l))
6802 if (l.lt.nres-1) then
6803 itl1=itortyp(itype(l+1))
6807 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6808 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6809 cd & ' itl',itl,' itl1',itl1
6812 s1=dip(3,jj,i)*dip(3,kk,k)
6814 s1=dip(2,jj,j)*dip(2,kk,l)
6817 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6818 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6820 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6821 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6823 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6824 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6826 call transpose2(EUg(1,1,k),auxmat(1,1))
6827 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6828 vv(1)=pizda(1,1)-pizda(2,2)
6829 vv(2)=pizda(2,1)+pizda(1,2)
6830 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6831 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6833 eello6_graph4=-(s1+s2+s3+s4)
6835 eello6_graph4=-(s2+s3+s4)
6837 if (.not. calc_grad) return
6838 C Derivatives in gamma(i-1)
6842 s1=dipderg(2,jj,i)*dip(3,kk,k)
6844 s1=dipderg(4,jj,j)*dip(2,kk,l)
6847 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6849 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6850 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6852 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6853 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6855 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6856 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6857 cd write (2,*) 'turn6 derivatives'
6859 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6861 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6865 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6867 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6871 C Derivatives in gamma(k-1)
6874 s1=dip(3,jj,i)*dipderg(2,kk,k)
6876 s1=dip(2,jj,j)*dipderg(4,kk,l)
6879 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6880 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6882 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6883 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6885 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6886 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6888 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6889 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6890 vv(1)=pizda(1,1)-pizda(2,2)
6891 vv(2)=pizda(2,1)+pizda(1,2)
6892 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6893 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6895 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6897 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6901 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6903 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6906 C Derivatives in gamma(j-1) or gamma(l-1)
6907 if (l.eq.j+1 .and. l.gt.1) then
6908 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6909 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6910 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6911 vv(1)=pizda(1,1)-pizda(2,2)
6912 vv(2)=pizda(2,1)+pizda(1,2)
6913 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6914 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6915 else if (j.gt.1) then
6916 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6917 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6918 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6919 vv(1)=pizda(1,1)-pizda(2,2)
6920 vv(2)=pizda(2,1)+pizda(1,2)
6921 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6922 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6923 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6925 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6928 C Cartesian derivatives.
6935 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6937 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6941 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6943 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6947 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6949 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6951 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6952 & b1(1,itj1),auxvec(1))
6953 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6955 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6956 & b1(1,itl1),auxvec(1))
6957 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6959 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6961 vv(1)=pizda(1,1)-pizda(2,2)
6962 vv(2)=pizda(2,1)+pizda(1,2)
6963 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6965 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6967 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6970 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6973 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6976 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6978 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6980 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6984 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6986 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6989 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6991 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6999 c----------------------------------------------------------------------------
7000 double precision function eello_turn6(i,jj,kk)
7001 implicit real*8 (a-h,o-z)
7002 include 'DIMENSIONS'
7003 include 'DIMENSIONS.ZSCOPT'
7004 include 'COMMON.IOUNITS'
7005 include 'COMMON.CHAIN'
7006 include 'COMMON.DERIV'
7007 include 'COMMON.INTERACT'
7008 include 'COMMON.CONTACTS'
7009 include 'COMMON.TORSION'
7010 include 'COMMON.VAR'
7011 include 'COMMON.GEO'
7012 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7013 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7015 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7016 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7017 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7018 C the respective energy moment and not to the cluster cumulant.
7023 iti=itortyp(itype(i))
7024 itk=itortyp(itype(k))
7025 itk1=itortyp(itype(k+1))
7026 itl=itortyp(itype(l))
7027 itj=itortyp(itype(j))
7028 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7029 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7030 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7035 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7037 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7041 derx_turn(lll,kkk,iii)=0.0d0
7048 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7050 cd write (2,*) 'eello6_5',eello6_5
7052 call transpose2(AEA(1,1,1),auxmat(1,1))
7053 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7054 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7055 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7059 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7060 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7061 s2 = scalar2(b1(1,itk),vtemp1(1))
7063 call transpose2(AEA(1,1,2),atemp(1,1))
7064 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7065 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7066 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7070 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7071 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7072 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7074 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7075 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7076 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7077 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7078 ss13 = scalar2(b1(1,itk),vtemp4(1))
7079 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7083 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7089 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7091 C Derivatives in gamma(i+2)
7093 call transpose2(AEA(1,1,1),auxmatd(1,1))
7094 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7095 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7096 call transpose2(AEAderg(1,1,2),atempd(1,1))
7097 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7098 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7102 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7103 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7104 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7110 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7111 C Derivatives in gamma(i+3)
7113 call transpose2(AEA(1,1,1),auxmatd(1,1))
7114 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7115 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7116 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7120 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7121 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7122 s2d = scalar2(b1(1,itk),vtemp1d(1))
7124 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7125 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7127 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7129 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7130 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7131 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7141 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7142 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7144 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7145 & -0.5d0*ekont*(s2d+s12d)
7147 C Derivatives in gamma(i+4)
7148 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7149 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7150 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7152 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7153 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7154 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7164 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7166 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7168 C Derivatives in gamma(i+5)
7170 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7171 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7172 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7176 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7177 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7178 s2d = scalar2(b1(1,itk),vtemp1d(1))
7180 call transpose2(AEA(1,1,2),atempd(1,1))
7181 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7182 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7186 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7187 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7189 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7190 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7191 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7201 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7202 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7204 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7205 & -0.5d0*ekont*(s2d+s12d)
7207 C Cartesian derivatives
7212 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7213 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7214 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7218 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7219 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7221 s2d = scalar2(b1(1,itk),vtemp1d(1))
7223 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7224 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7225 s8d = -(atempd(1,1)+atempd(2,2))*
7226 & scalar2(cc(1,1,itl),vtemp2(1))
7230 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7232 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7233 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7240 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7243 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7247 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7248 & - 0.5d0*(s8d+s12d)
7250 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7259 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7261 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7262 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7263 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7264 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7265 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7267 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7268 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7269 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7273 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7274 cd & 16*eel_turn6_num
7276 if (j.lt.nres-1) then
7283 if (l.lt.nres-1) then
7291 ggg1(ll)=eel_turn6*g_contij(ll,1)
7292 ggg2(ll)=eel_turn6*g_contij(ll,2)
7293 ghalf=0.5d0*ggg1(ll)
7295 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7296 & +ekont*derx_turn(ll,2,1)
7297 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7298 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7299 & +ekont*derx_turn(ll,4,1)
7300 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7301 ghalf=0.5d0*ggg2(ll)
7303 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7304 & +ekont*derx_turn(ll,2,2)
7305 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7306 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7307 & +ekont*derx_turn(ll,4,2)
7308 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7313 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7318 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7324 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7329 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7333 cd write (2,*) iii,g_corr6_loc(iii)
7336 eello_turn6=ekont*eel_turn6
7337 cd write (2,*) 'ekont',ekont
7338 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7341 crc-------------------------------------------------
7342 SUBROUTINE MATVEC2(A1,V1,V2)
7343 implicit real*8 (a-h,o-z)
7344 include 'DIMENSIONS'
7345 DIMENSION A1(2,2),V1(2),V2(2)
7349 c 3 VI=VI+A1(I,K)*V1(K)
7353 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7354 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7359 C---------------------------------------
7360 SUBROUTINE MATMAT2(A1,A2,A3)
7361 implicit real*8 (a-h,o-z)
7362 include 'DIMENSIONS'
7363 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7364 c DIMENSION AI3(2,2)
7368 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7374 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7375 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7376 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7377 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7385 c-------------------------------------------------------------------------
7386 double precision function scalar2(u,v)
7388 double precision u(2),v(2)
7391 scalar2=u(1)*v(1)+u(2)*v(2)
7395 C-----------------------------------------------------------------------------
7397 subroutine transpose2(a,at)
7399 double precision a(2,2),at(2,2)
7406 c--------------------------------------------------------------------------
7407 subroutine transpose(n,a,at)
7410 double precision a(n,n),at(n,n)
7418 C---------------------------------------------------------------------------
7419 subroutine prodmat3(a1,a2,kk,transp,prod)
7422 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7424 crc double precision auxmat(2,2),prod_(2,2)
7427 crc call transpose2(kk(1,1),auxmat(1,1))
7428 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7429 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7431 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7432 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7433 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7434 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7435 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7436 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7437 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7438 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7441 crc call matmat2(a1(1,1),kk(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(2,1))*a2(1,1)
7445 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7446 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7447 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7448 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7449 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7450 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7451 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7454 c call transpose2(a2(1,1),a2t(1,1))
7457 crc print *,((prod_(i,j),i=1,2),j=1,2)
7458 crc print *,((prod(i,j),i=1,2),j=1,2)
7462 C-----------------------------------------------------------------------------
7463 double precision function scalar(u,v)
7465 double precision u(3),v(3)