1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
157 c if (dyn_ss) call dyn_set_nss
161 if (isnan(etot).ne.0) energia(0)=1.0d+99
163 if (isnan(etot)) energia(0)=1.0d+99
168 idumm=proc_proc(etot,i)
170 call proc_proc(etot,i)
172 if(i.eq.1)energia(0)=1.0d+99
179 C Sum up the components of the Cartesian gradient.
184 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
185 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
187 & wstrain*ghpbc(j,i)+
188 & wcorr*fact(3)*gradcorr(j,i)+
189 & wel_loc*fact(2)*gel_loc(j,i)+
190 & wturn3*fact(2)*gcorr3_turn(j,i)+
191 & wturn4*fact(3)*gcorr4_turn(j,i)+
192 & wcorr5*fact(4)*gradcorr5(j,i)+
193 & wcorr6*fact(5)*gradcorr6(j,i)+
194 & wturn6*fact(5)*gcorr6_turn(j,i)+
195 & wsccor*fact(2)*gsccorc(j,i)
196 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
198 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
199 & wsccor*fact(2)*gsccorx(j,i)
204 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
205 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
207 & wcorr*fact(3)*gradcorr(j,i)+
208 & wel_loc*fact(2)*gel_loc(j,i)+
209 & wturn3*fact(2)*gcorr3_turn(j,i)+
210 & wturn4*fact(3)*gcorr4_turn(j,i)+
211 & wcorr5*fact(4)*gradcorr5(j,i)+
212 & wcorr6*fact(5)*gradcorr6(j,i)+
213 & wturn6*fact(5)*gcorr6_turn(j,i)+
214 & wsccor*fact(2)*gsccorc(j,i)
215 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
217 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
218 & wsccor*fact(1)*gsccorx(j,i)
225 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
226 & +wcorr5*fact(4)*g_corr5_loc(i)
227 & +wcorr6*fact(5)*g_corr6_loc(i)
228 & +wturn4*fact(3)*gel_loc_turn4(i)
229 & +wturn3*fact(2)*gel_loc_turn3(i)
230 & +wturn6*fact(5)*gel_loc_turn6(i)
231 & +wel_loc*fact(2)*gel_loc_loc(i)
232 & +wsccor*fact(1)*gsccor_loc(i)
237 C------------------------------------------------------------------------
238 subroutine enerprint(energia,fact)
239 implicit real*8 (a-h,o-z)
241 include 'DIMENSIONS.ZSCOPT'
242 include 'COMMON.IOUNITS'
243 include 'COMMON.FFIELD'
244 include 'COMMON.SBRIDGE'
245 double precision energia(0:max_ene),fact(6)
247 evdw=energia(1)+fact(6)*energia(21)
249 evdw2=energia(2)+energia(17)
261 eello_turn3=energia(8)
262 eello_turn4=energia(9)
263 eello_turn6=energia(10)
270 edihcnstr=energia(20)
273 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
275 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
276 & etors_d,wtor_d*fact(2),ehpb,wstrain,
277 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
278 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
279 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
280 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
281 10 format (/'Virtual-chain energies:'//
282 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
283 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
284 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
285 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
286 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
287 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
288 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
289 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
290 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
291 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
292 & ' (SS bridges & dist. cnstr.)'/
293 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
297 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
298 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
299 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
300 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
301 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
302 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
303 & 'ETOT= ',1pE16.6,' (total)')
305 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
306 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
307 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
308 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
309 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
310 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
311 & edihcnstr,ebr*nss,etot
312 10 format (/'Virtual-chain energies:'//
313 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
314 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
315 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
316 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
317 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
318 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
319 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
320 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
321 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
322 & ' (SS bridges & dist. cnstr.)'/
323 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
327 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
328 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
329 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
330 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
331 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
332 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
333 & 'ETOT= ',1pE16.6,' (total)')
337 C-----------------------------------------------------------------------
338 subroutine elj(evdw,evdw_t)
340 C This subroutine calculates the interaction energy of nonbonded side chains
341 C assuming the LJ potential of interaction.
343 implicit real*8 (a-h,o-z)
345 include 'DIMENSIONS.ZSCOPT'
346 include "DIMENSIONS.COMPAR"
347 parameter (accur=1.0d-10)
350 include 'COMMON.LOCAL'
351 include 'COMMON.CHAIN'
352 include 'COMMON.DERIV'
353 include 'COMMON.INTERACT'
354 include 'COMMON.TORSION'
355 include 'COMMON.ENEPS'
356 include 'COMMON.SBRIDGE'
357 include 'COMMON.NAMES'
358 include 'COMMON.IOUNITS'
359 include 'COMMON.CONTACTS'
363 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
366 eneps_temp(j,i)=0.0d0
380 C Calculate SC interaction energy.
383 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
384 cd & 'iend=',iend(i,iint)
385 do j=istart(i,iint),iend(i,iint)
390 C Change 12/1/95 to calculate four-body interactions
391 rij=xj*xj+yj*yj+zj*zj
393 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
394 eps0ij=eps(itypi,itypj)
396 e1=fac*fac*aa(itypi,itypj)
397 e2=fac*bb(itypi,itypj)
399 ij=icant(itypi,itypj)
400 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
401 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
402 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
403 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
404 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
405 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
406 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
407 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
408 if (bb(itypi,itypj).gt.0.0d0) then
415 C Calculate the components of the gradient in DC and X
417 fac=-rrij*(e1+evdwij)
422 gvdwx(k,i)=gvdwx(k,i)-gg(k)
423 gvdwx(k,j)=gvdwx(k,j)+gg(k)
427 gvdwc(l,k)=gvdwc(l,k)+gg(l)
432 C 12/1/95, revised on 5/20/97
434 C Calculate the contact function. The ith column of the array JCONT will
435 C contain the numbers of atoms that make contacts with the atom I (of numbers
436 C greater than I). The arrays FACONT and GACONT will contain the values of
437 C the contact function and its derivative.
439 C Uncomment next line, if the correlation interactions include EVDW explicitly.
440 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
441 C Uncomment next line, if the correlation interactions are contact function only
442 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
444 sigij=sigma(itypi,itypj)
445 r0ij=rs0(itypi,itypj)
447 C Check whether the SC's are not too far to make a contact.
450 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
451 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
453 if (fcont.gt.0.0D0) then
454 C If the SC-SC distance if close to sigma, apply spline.
455 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
456 cAdam & fcont1,fprimcont1)
457 cAdam fcont1=1.0d0-fcont1
458 cAdam if (fcont1.gt.0.0d0) then
459 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
460 cAdam fcont=fcont*fcont1
462 C Uncomment following 4 lines to have the geometric average of the epsilon0's
463 cga eps0ij=1.0d0/dsqrt(eps0ij)
465 cga gg(k)=gg(k)*eps0ij
467 cga eps0ij=-evdwij*eps0ij
468 C Uncomment for AL's type of SC correlation interactions.
470 num_conti=num_conti+1
472 facont(num_conti,i)=fcont*eps0ij
473 fprimcont=eps0ij*fprimcont/rij
475 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
476 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
477 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
478 C Uncomment following 3 lines for Skolnick's type of SC correlation.
479 gacont(1,num_conti,i)=-fprimcont*xj
480 gacont(2,num_conti,i)=-fprimcont*yj
481 gacont(3,num_conti,i)=-fprimcont*zj
482 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
483 cd write (iout,'(2i3,3f10.5)')
484 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
490 num_cont(i)=num_conti
495 gvdwc(j,i)=expon*gvdwc(j,i)
496 gvdwx(j,i)=expon*gvdwx(j,i)
500 C******************************************************************************
504 C To save time, the factor of EXPON has been extracted from ALL components
505 C of GVDWC and GRADX. Remember to multiply them by this factor before further
508 C******************************************************************************
511 C-----------------------------------------------------------------------------
512 subroutine eljk(evdw,evdw_t)
514 C This subroutine calculates the interaction energy of nonbonded side chains
515 C assuming the LJK potential of interaction.
517 implicit real*8 (a-h,o-z)
519 include 'DIMENSIONS.ZSCOPT'
520 include "DIMENSIONS.COMPAR"
523 include 'COMMON.LOCAL'
524 include 'COMMON.CHAIN'
525 include 'COMMON.DERIV'
526 include 'COMMON.INTERACT'
527 include 'COMMON.ENEPS'
528 include 'COMMON.IOUNITS'
529 include 'COMMON.NAMES'
534 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
537 eneps_temp(j,i)=0.0d0
549 C Calculate SC interaction energy.
552 do j=istart(i,iint),iend(i,iint)
557 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
559 e_augm=augm(itypi,itypj)*fac_augm
562 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
563 fac=r_shift_inv**expon
564 e1=fac*fac*aa(itypi,itypj)
565 e2=fac*bb(itypi,itypj)
567 ij=icant(itypi,itypj)
568 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
569 & /dabs(eps(itypi,itypj))
570 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
571 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
572 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
573 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
574 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
575 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
576 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
577 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
578 if (bb(itypi,itypj).gt.0.0d0) then
585 C Calculate the components of the gradient in DC and X
587 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
592 gvdwx(k,i)=gvdwx(k,i)-gg(k)
593 gvdwx(k,j)=gvdwx(k,j)+gg(k)
597 gvdwc(l,k)=gvdwc(l,k)+gg(l)
607 gvdwc(j,i)=expon*gvdwc(j,i)
608 gvdwx(j,i)=expon*gvdwx(j,i)
614 C-----------------------------------------------------------------------------
615 subroutine ebp(evdw,evdw_t)
617 C This subroutine calculates the interaction energy of nonbonded side chains
618 C assuming the Berne-Pechukas potential of interaction.
620 implicit real*8 (a-h,o-z)
622 include 'DIMENSIONS.ZSCOPT'
623 include "DIMENSIONS.COMPAR"
626 include 'COMMON.LOCAL'
627 include 'COMMON.CHAIN'
628 include 'COMMON.DERIV'
629 include 'COMMON.NAMES'
630 include 'COMMON.INTERACT'
631 include 'COMMON.ENEPS'
632 include 'COMMON.IOUNITS'
633 include 'COMMON.CALC'
635 c double precision rrsave(maxdim)
641 eneps_temp(j,i)=0.0d0
646 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
647 c if (icall.eq.0) then
659 dxi=dc_norm(1,nres+i)
660 dyi=dc_norm(2,nres+i)
661 dzi=dc_norm(3,nres+i)
662 dsci_inv=vbld_inv(i+nres)
664 C Calculate SC interaction energy.
667 do j=istart(i,iint),iend(i,iint)
670 dscj_inv=vbld_inv(j+nres)
671 chi1=chi(itypi,itypj)
672 chi2=chi(itypj,itypi)
679 alf12=0.5D0*(alf1+alf2)
680 C For diagnostics only!!!
693 dxj=dc_norm(1,nres+j)
694 dyj=dc_norm(2,nres+j)
695 dzj=dc_norm(3,nres+j)
696 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
697 cd if (icall.eq.0) then
703 C Calculate the angle-dependent terms of energy & contributions to derivatives.
705 C Calculate whole angle-dependent part of epsilon and contributions
707 fac=(rrij*sigsq)**expon2
708 e1=fac*fac*aa(itypi,itypj)
709 e2=fac*bb(itypi,itypj)
710 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
711 eps2der=evdwij*eps3rt
712 eps3der=evdwij*eps2rt
713 evdwij=evdwij*eps2rt*eps3rt
714 ij=icant(itypi,itypj)
715 aux=eps1*eps2rt**2*eps3rt**2
716 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
717 & /dabs(eps(itypi,itypj))
718 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
719 if (bb(itypi,itypj).gt.0.0d0) then
726 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
727 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
728 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
729 cd & restyp(itypi),i,restyp(itypj),j,
730 cd & epsi,sigm,chi1,chi2,chip1,chip2,
731 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
732 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
735 C Calculate gradient components.
736 e1=e1*eps1*eps2rt**2*eps3rt**2
737 fac=-expon*(e1+evdwij)
740 C Calculate radial part of the gradient
744 C Calculate the angular part of the gradient and sum add the contributions
745 C to the appropriate components of the Cartesian gradient.
754 C-----------------------------------------------------------------------------
755 subroutine egb(evdw,evdw_t)
757 C This subroutine calculates the interaction energy of nonbonded side chains
758 C assuming the Gay-Berne potential of interaction.
760 implicit real*8 (a-h,o-z)
762 include 'DIMENSIONS.ZSCOPT'
763 include "DIMENSIONS.COMPAR"
766 include 'COMMON.LOCAL'
767 include 'COMMON.CHAIN'
768 include 'COMMON.DERIV'
769 include 'COMMON.NAMES'
770 include 'COMMON.INTERACT'
771 include 'COMMON.ENEPS'
772 include 'COMMON.IOUNITS'
773 include 'COMMON.CALC'
774 include 'COMMON.SBRIDGE'
781 eneps_temp(j,i)=0.0d0
784 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
788 c if (icall.gt.0) lprn=.true.
796 dxi=dc_norm(1,nres+i)
797 dyi=dc_norm(2,nres+i)
798 dzi=dc_norm(3,nres+i)
799 dsci_inv=vbld_inv(i+nres)
801 C Calculate SC interaction energy.
804 do j=istart(i,iint),iend(i,iint)
805 C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j)
806 C /06/28/2013 Adasko: In case of dyn_ss - dynamic disulfide bond
807 C formation no electrostatic interactions should be calculated. If it
808 C would be allowed NaN would appear
809 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
810 C /06/28/2013 Adasko: dyn_ss_mask is logical statement wheather this Cys
811 C residue can or cannot form disulfide bond. There is still bug allowing
812 C Cys...Cys...Cys bond formation
813 call dyn_ssbond_ene(i,j,evdwij)
814 C /06/28/2013 Adasko: dyn_ssbond_ene is dynamic SS bond foration energy
817 c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
818 c & 'evdw',i,j,evdwij,' ss'
822 dscj_inv=vbld_inv(j+nres)
823 sig0ij=sigma(itypi,itypj)
824 chi1=chi(itypi,itypj)
825 chi2=chi(itypj,itypi)
832 alf12=0.5D0*(alf1+alf2)
833 C For diagnostics only!!!
846 dxj=dc_norm(1,nres+j)
847 dyj=dc_norm(2,nres+j)
848 dzj=dc_norm(3,nres+j)
849 c write (iout,*) i,j,xj,yj,zj
850 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
852 C Calculate angle-dependent terms of energy and contributions to their
856 sig=sig0ij*dsqrt(sigsq)
857 rij_shift=1.0D0/rij-sig+sig0ij
858 C I hate to put IF's in the loops, but here don't have another choice!!!!
859 if (rij_shift.le.0.0D0) then
864 c---------------------------------------------------------------
865 rij_shift=1.0D0/rij_shift
867 e1=fac*fac*aa(itypi,itypj)
868 e2=fac*bb(itypi,itypj)
869 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
870 eps2der=evdwij*eps3rt
871 eps3der=evdwij*eps2rt
872 evdwij=evdwij*eps2rt*eps3rt
873 if (bb(itypi,itypj).gt.0) then
878 ij=icant(itypi,itypj)
879 aux=eps1*eps2rt**2*eps3rt**2
880 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
881 & /dabs(eps(itypi,itypj))
882 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
883 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
884 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
885 c & aux*e2/eps(itypi,itypj)
886 c write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
888 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
889 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
890 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
891 & restyp(itypi),i,restyp(itypj),j,
892 & epsi,sigm,chi1,chi2,chip1,chip2,
893 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
894 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
898 C Calculate gradient components.
899 e1=e1*eps1*eps2rt**2*eps3rt**2
900 fac=-expon*(e1+evdwij)*rij_shift
903 C Calculate the radial part of the gradient
907 C Calculate angular part of the gradient.
916 C-----------------------------------------------------------------------------
917 subroutine egbv(evdw,evdw_t)
919 C This subroutine calculates the interaction energy of nonbonded side chains
920 C assuming the Gay-Berne-Vorobjev potential of interaction.
922 implicit real*8 (a-h,o-z)
924 include 'DIMENSIONS.ZSCOPT'
925 include "DIMENSIONS.COMPAR"
928 include 'COMMON.LOCAL'
929 include 'COMMON.CHAIN'
930 include 'COMMON.DERIV'
931 include 'COMMON.NAMES'
932 include 'COMMON.INTERACT'
933 include 'COMMON.ENEPS'
934 include 'COMMON.IOUNITS'
935 include 'COMMON.CALC'
942 eneps_temp(j,i)=0.0d0
947 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
950 c if (icall.gt.0) lprn=.true.
958 dxi=dc_norm(1,nres+i)
959 dyi=dc_norm(2,nres+i)
960 dzi=dc_norm(3,nres+i)
961 dsci_inv=vbld_inv(i+nres)
963 C Calculate SC interaction energy.
966 do j=istart(i,iint),iend(i,iint)
969 dscj_inv=vbld_inv(j+nres)
970 sig0ij=sigma(itypi,itypj)
972 chi1=chi(itypi,itypj)
973 chi2=chi(itypj,itypi)
980 alf12=0.5D0*(alf1+alf2)
981 C For diagnostics only!!!
994 dxj=dc_norm(1,nres+j)
995 dyj=dc_norm(2,nres+j)
996 dzj=dc_norm(3,nres+j)
997 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
999 C Calculate angle-dependent terms of energy and contributions to their
1003 sig=sig0ij*dsqrt(sigsq)
1004 rij_shift=1.0D0/rij-sig+r0ij
1005 C I hate to put IF's in the loops, but here don't have another choice!!!!
1006 if (rij_shift.le.0.0D0) then
1011 c---------------------------------------------------------------
1012 rij_shift=1.0D0/rij_shift
1013 fac=rij_shift**expon
1014 e1=fac*fac*aa(itypi,itypj)
1015 e2=fac*bb(itypi,itypj)
1016 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1017 eps2der=evdwij*eps3rt
1018 eps3der=evdwij*eps2rt
1019 fac_augm=rrij**expon
1020 e_augm=augm(itypi,itypj)*fac_augm
1021 evdwij=evdwij*eps2rt*eps3rt
1022 if (bb(itypi,itypj).gt.0.0d0) then
1023 evdw=evdw+evdwij+e_augm
1025 evdw_t=evdw_t+evdwij+e_augm
1027 ij=icant(itypi,itypj)
1028 aux=eps1*eps2rt**2*eps3rt**2
1029 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1030 & /dabs(eps(itypi,itypj))
1031 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1032 c eneps_temp(ij)=eneps_temp(ij)
1033 c & +(evdwij+e_augm)/eps(itypi,itypj)
1035 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1036 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1037 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1038 c & restyp(itypi),i,restyp(itypj),j,
1039 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1040 c & chi1,chi2,chip1,chip2,
1041 c & eps1,eps2rt**2,eps3rt**2,
1042 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1046 C Calculate gradient components.
1047 e1=e1*eps1*eps2rt**2*eps3rt**2
1048 fac=-expon*(e1+evdwij)*rij_shift
1050 fac=rij*fac-2*expon*rrij*e_augm
1051 C Calculate the radial part of the gradient
1055 C Calculate angular part of the gradient.
1063 C-----------------------------------------------------------------------------
1064 subroutine sc_angular
1065 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1066 C om12. Called by ebp, egb, and egbv.
1068 include 'COMMON.CALC'
1072 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1073 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1074 om12=dxi*dxj+dyi*dyj+dzi*dzj
1076 C Calculate eps1(om12) and its derivative in om12
1077 faceps1=1.0D0-om12*chiom12
1078 faceps1_inv=1.0D0/faceps1
1079 eps1=dsqrt(faceps1_inv)
1080 C Following variable is eps1*deps1/dom12
1081 eps1_om12=faceps1_inv*chiom12
1082 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1087 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1088 sigsq=1.0D0-facsig*faceps1_inv
1089 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1090 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1091 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1092 C Calculate eps2 and its derivatives in om1, om2, and om12.
1095 chipom12=chip12*om12
1096 facp=1.0D0-om12*chipom12
1098 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1099 C Following variable is the square root of eps2
1100 eps2rt=1.0D0-facp1*facp_inv
1101 C Following three variables are the derivatives of the square root of eps
1102 C in om1, om2, and om12.
1103 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1104 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1105 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1106 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1107 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1108 C Calculate whole angle-dependent part of epsilon and contributions
1109 C to its derivatives
1112 C----------------------------------------------------------------------------
1114 implicit real*8 (a-h,o-z)
1115 include 'DIMENSIONS'
1116 include 'DIMENSIONS.ZSCOPT'
1117 include 'COMMON.CHAIN'
1118 include 'COMMON.DERIV'
1119 include 'COMMON.CALC'
1120 double precision dcosom1(3),dcosom2(3)
1121 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1122 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1123 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1124 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1126 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1127 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1130 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1133 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1134 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1135 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1136 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1137 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1138 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1141 C Calculate the components of the gradient in DC and X
1145 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1150 c------------------------------------------------------------------------------
1151 subroutine vec_and_deriv
1152 implicit real*8 (a-h,o-z)
1153 include 'DIMENSIONS'
1154 include 'DIMENSIONS.ZSCOPT'
1155 include 'COMMON.IOUNITS'
1156 include 'COMMON.GEO'
1157 include 'COMMON.VAR'
1158 include 'COMMON.LOCAL'
1159 include 'COMMON.CHAIN'
1160 include 'COMMON.VECTORS'
1161 include 'COMMON.DERIV'
1162 include 'COMMON.INTERACT'
1163 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1164 C Compute the local reference systems. For reference system (i), the
1165 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1166 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1168 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1169 if (i.eq.nres-1) then
1170 C Case of the last full residue
1171 C Compute the Z-axis
1172 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1173 costh=dcos(pi-theta(nres))
1174 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1179 C Compute the derivatives of uz
1181 uzder(2,1,1)=-dc_norm(3,i-1)
1182 uzder(3,1,1)= dc_norm(2,i-1)
1183 uzder(1,2,1)= dc_norm(3,i-1)
1185 uzder(3,2,1)=-dc_norm(1,i-1)
1186 uzder(1,3,1)=-dc_norm(2,i-1)
1187 uzder(2,3,1)= dc_norm(1,i-1)
1190 uzder(2,1,2)= dc_norm(3,i)
1191 uzder(3,1,2)=-dc_norm(2,i)
1192 uzder(1,2,2)=-dc_norm(3,i)
1194 uzder(3,2,2)= dc_norm(1,i)
1195 uzder(1,3,2)= dc_norm(2,i)
1196 uzder(2,3,2)=-dc_norm(1,i)
1199 C Compute the Y-axis
1202 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1205 C Compute the derivatives of uy
1208 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1209 & -dc_norm(k,i)*dc_norm(j,i-1)
1210 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1212 uyder(j,j,1)=uyder(j,j,1)-costh
1213 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1218 uygrad(l,k,j,i)=uyder(l,k,j)
1219 uzgrad(l,k,j,i)=uzder(l,k,j)
1223 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1224 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1225 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1226 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1230 C Compute the Z-axis
1231 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1232 costh=dcos(pi-theta(i+2))
1233 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1238 C Compute the derivatives of uz
1240 uzder(2,1,1)=-dc_norm(3,i+1)
1241 uzder(3,1,1)= dc_norm(2,i+1)
1242 uzder(1,2,1)= dc_norm(3,i+1)
1244 uzder(3,2,1)=-dc_norm(1,i+1)
1245 uzder(1,3,1)=-dc_norm(2,i+1)
1246 uzder(2,3,1)= dc_norm(1,i+1)
1249 uzder(2,1,2)= dc_norm(3,i)
1250 uzder(3,1,2)=-dc_norm(2,i)
1251 uzder(1,2,2)=-dc_norm(3,i)
1253 uzder(3,2,2)= dc_norm(1,i)
1254 uzder(1,3,2)= dc_norm(2,i)
1255 uzder(2,3,2)=-dc_norm(1,i)
1258 C Compute the Y-axis
1261 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1264 C Compute the derivatives of uy
1267 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1268 & -dc_norm(k,i)*dc_norm(j,i+1)
1269 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1271 uyder(j,j,1)=uyder(j,j,1)-costh
1272 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1277 uygrad(l,k,j,i)=uyder(l,k,j)
1278 uzgrad(l,k,j,i)=uzder(l,k,j)
1282 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1283 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1284 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1285 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1291 vbld_inv_temp(1)=vbld_inv(i+1)
1292 if (i.lt.nres-1) then
1293 vbld_inv_temp(2)=vbld_inv(i+2)
1295 vbld_inv_temp(2)=vbld_inv(i)
1300 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1301 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1309 C-----------------------------------------------------------------------------
1310 subroutine vec_and_deriv_test
1311 implicit real*8 (a-h,o-z)
1312 include 'DIMENSIONS'
1313 include 'DIMENSIONS.ZSCOPT'
1314 include 'COMMON.IOUNITS'
1315 include 'COMMON.GEO'
1316 include 'COMMON.VAR'
1317 include 'COMMON.LOCAL'
1318 include 'COMMON.CHAIN'
1319 include 'COMMON.VECTORS'
1320 dimension uyder(3,3,2),uzder(3,3,2)
1321 C Compute the local reference systems. For reference system (i), the
1322 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1323 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1325 if (i.eq.nres-1) then
1326 C Case of the last full residue
1327 C Compute the Z-axis
1328 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1329 costh=dcos(pi-theta(nres))
1330 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1331 c write (iout,*) 'fac',fac,
1332 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1333 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1337 C Compute the derivatives of uz
1339 uzder(2,1,1)=-dc_norm(3,i-1)
1340 uzder(3,1,1)= dc_norm(2,i-1)
1341 uzder(1,2,1)= dc_norm(3,i-1)
1343 uzder(3,2,1)=-dc_norm(1,i-1)
1344 uzder(1,3,1)=-dc_norm(2,i-1)
1345 uzder(2,3,1)= dc_norm(1,i-1)
1348 uzder(2,1,2)= dc_norm(3,i)
1349 uzder(3,1,2)=-dc_norm(2,i)
1350 uzder(1,2,2)=-dc_norm(3,i)
1352 uzder(3,2,2)= dc_norm(1,i)
1353 uzder(1,3,2)= dc_norm(2,i)
1354 uzder(2,3,2)=-dc_norm(1,i)
1356 C Compute the Y-axis
1358 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1361 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1362 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1363 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1365 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1368 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1369 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1372 c write (iout,*) 'facy',facy,
1373 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1374 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1376 uy(k,i)=facy*uy(k,i)
1378 C Compute the derivatives of uy
1381 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1382 & -dc_norm(k,i)*dc_norm(j,i-1)
1383 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1385 c uyder(j,j,1)=uyder(j,j,1)-costh
1386 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1387 uyder(j,j,1)=uyder(j,j,1)
1388 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1389 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1395 uygrad(l,k,j,i)=uyder(l,k,j)
1396 uzgrad(l,k,j,i)=uzder(l,k,j)
1400 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1401 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1402 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1403 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1406 C Compute the Z-axis
1407 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1408 costh=dcos(pi-theta(i+2))
1409 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1410 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1414 C Compute the derivatives of uz
1416 uzder(2,1,1)=-dc_norm(3,i+1)
1417 uzder(3,1,1)= dc_norm(2,i+1)
1418 uzder(1,2,1)= dc_norm(3,i+1)
1420 uzder(3,2,1)=-dc_norm(1,i+1)
1421 uzder(1,3,1)=-dc_norm(2,i+1)
1422 uzder(2,3,1)= dc_norm(1,i+1)
1425 uzder(2,1,2)= dc_norm(3,i)
1426 uzder(3,1,2)=-dc_norm(2,i)
1427 uzder(1,2,2)=-dc_norm(3,i)
1429 uzder(3,2,2)= dc_norm(1,i)
1430 uzder(1,3,2)= dc_norm(2,i)
1431 uzder(2,3,2)=-dc_norm(1,i)
1433 C Compute the Y-axis
1435 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1436 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1437 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1439 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1442 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1443 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1446 c write (iout,*) 'facy',facy,
1447 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1448 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1450 uy(k,i)=facy*uy(k,i)
1452 C Compute the derivatives of uy
1455 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1456 & -dc_norm(k,i)*dc_norm(j,i+1)
1457 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1459 c uyder(j,j,1)=uyder(j,j,1)-costh
1460 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1461 uyder(j,j,1)=uyder(j,j,1)
1462 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1463 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1469 uygrad(l,k,j,i)=uyder(l,k,j)
1470 uzgrad(l,k,j,i)=uzder(l,k,j)
1474 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1475 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1476 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1477 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1484 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1485 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1492 C-----------------------------------------------------------------------------
1493 subroutine check_vecgrad
1494 implicit real*8 (a-h,o-z)
1495 include 'DIMENSIONS'
1496 include 'DIMENSIONS.ZSCOPT'
1497 include 'COMMON.IOUNITS'
1498 include 'COMMON.GEO'
1499 include 'COMMON.VAR'
1500 include 'COMMON.LOCAL'
1501 include 'COMMON.CHAIN'
1502 include 'COMMON.VECTORS'
1503 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1504 dimension uyt(3,maxres),uzt(3,maxres)
1505 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1506 double precision delta /1.0d-7/
1509 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1510 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1511 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1512 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1513 cd & (dc_norm(if90,i),if90=1,3)
1514 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1515 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1516 cd write(iout,'(a)')
1522 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1523 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1536 cd write (iout,*) 'i=',i
1538 erij(k)=dc_norm(k,i)
1542 dc_norm(k,i)=erij(k)
1544 dc_norm(j,i)=dc_norm(j,i)+delta
1545 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1547 c dc_norm(k,i)=dc_norm(k,i)/fac
1549 c write (iout,*) (dc_norm(k,i),k=1,3)
1550 c write (iout,*) (erij(k),k=1,3)
1553 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1554 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1555 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1556 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1558 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1559 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1560 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1563 dc_norm(k,i)=erij(k)
1566 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1567 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1568 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1569 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1570 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1571 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1572 cd write (iout,'(a)')
1577 C--------------------------------------------------------------------------
1578 subroutine set_matrices
1579 implicit real*8 (a-h,o-z)
1580 include 'DIMENSIONS'
1581 include 'DIMENSIONS.ZSCOPT'
1582 include 'COMMON.IOUNITS'
1583 include 'COMMON.GEO'
1584 include 'COMMON.VAR'
1585 include 'COMMON.LOCAL'
1586 include 'COMMON.CHAIN'
1587 include 'COMMON.DERIV'
1588 include 'COMMON.INTERACT'
1589 include 'COMMON.CONTACTS'
1590 include 'COMMON.TORSION'
1591 include 'COMMON.VECTORS'
1592 include 'COMMON.FFIELD'
1593 double precision auxvec(2),auxmat(2,2)
1595 C Compute the virtual-bond-torsional-angle dependent quantities needed
1596 C to calculate the el-loc multibody terms of various order.
1599 if (i .lt. nres+1) then
1636 if (i .gt. 3 .and. i .lt. nres+1) then
1637 obrot_der(1,i-2)=-sin1
1638 obrot_der(2,i-2)= cos1
1639 Ugder(1,1,i-2)= sin1
1640 Ugder(1,2,i-2)=-cos1
1641 Ugder(2,1,i-2)=-cos1
1642 Ugder(2,2,i-2)=-sin1
1645 obrot2_der(1,i-2)=-dwasin2
1646 obrot2_der(2,i-2)= dwacos2
1647 Ug2der(1,1,i-2)= dwasin2
1648 Ug2der(1,2,i-2)=-dwacos2
1649 Ug2der(2,1,i-2)=-dwacos2
1650 Ug2der(2,2,i-2)=-dwasin2
1652 obrot_der(1,i-2)=0.0d0
1653 obrot_der(2,i-2)=0.0d0
1654 Ugder(1,1,i-2)=0.0d0
1655 Ugder(1,2,i-2)=0.0d0
1656 Ugder(2,1,i-2)=0.0d0
1657 Ugder(2,2,i-2)=0.0d0
1658 obrot2_der(1,i-2)=0.0d0
1659 obrot2_der(2,i-2)=0.0d0
1660 Ug2der(1,1,i-2)=0.0d0
1661 Ug2der(1,2,i-2)=0.0d0
1662 Ug2der(2,1,i-2)=0.0d0
1663 Ug2der(2,2,i-2)=0.0d0
1665 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
1666 iti = itortyp(itype(i-2))
1670 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1671 iti1 = itortyp(itype(i-1))
1675 cd write (iout,*) '*******i',i,' iti1',iti
1676 cd write (iout,*) 'b1',b1(:,iti)
1677 cd write (iout,*) 'b2',b2(:,iti)
1678 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1679 if (i .gt. iatel_s+2) then
1680 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1681 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1682 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1683 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1684 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1685 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1686 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1696 DtUg2(l,k,i-2)=0.0d0
1700 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1701 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1702 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1703 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1704 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1705 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1706 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1708 muder(k,i-2)=Ub2der(k,i-2)
1710 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
1711 iti1 = itortyp(itype(i-1))
1716 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1718 C Vectors and matrices dependent on a single virtual-bond dihedral.
1719 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1720 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1721 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1722 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1723 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1724 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1725 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1726 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1727 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1728 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1729 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1731 C Matrices dependent on two consecutive virtual-bond dihedrals.
1732 C The order of matrices is from left to right.
1734 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1735 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1736 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1737 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1738 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1739 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1740 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1741 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1744 cd iti = itortyp(itype(i))
1747 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1748 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1753 C--------------------------------------------------------------------------
1754 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1756 C This subroutine calculates the average interaction energy and its gradient
1757 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1758 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1759 C The potential depends both on the distance of peptide-group centers and on
1760 C the orientation of the CA-CA virtual bonds.
1762 implicit real*8 (a-h,o-z)
1763 include 'DIMENSIONS'
1764 include 'DIMENSIONS.ZSCOPT'
1765 include 'COMMON.CONTROL'
1766 include 'COMMON.IOUNITS'
1767 include 'COMMON.GEO'
1768 include 'COMMON.VAR'
1769 include 'COMMON.LOCAL'
1770 include 'COMMON.CHAIN'
1771 include 'COMMON.DERIV'
1772 include 'COMMON.INTERACT'
1773 include 'COMMON.CONTACTS'
1774 include 'COMMON.TORSION'
1775 include 'COMMON.VECTORS'
1776 include 'COMMON.FFIELD'
1777 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1778 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1779 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1780 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1781 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1782 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1783 double precision scal_el /0.5d0/
1785 C 13-go grudnia roku pamietnego...
1786 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1787 & 0.0d0,1.0d0,0.0d0,
1788 & 0.0d0,0.0d0,1.0d0/
1789 cd write(iout,*) 'In EELEC'
1791 cd write(iout,*) 'Type',i
1792 cd write(iout,*) 'B1',B1(:,i)
1793 cd write(iout,*) 'B2',B2(:,i)
1794 cd write(iout,*) 'CC',CC(:,:,i)
1795 cd write(iout,*) 'DD',DD(:,:,i)
1796 cd write(iout,*) 'EE',EE(:,:,i)
1798 cd call check_vecgrad
1800 if (icheckgrad.eq.1) then
1802 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1804 dc_norm(k,i)=dc(k,i)*fac
1806 c write (iout,*) 'i',i,' fac',fac
1809 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1810 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1811 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1812 cd if (wel_loc.gt.0.0d0) then
1813 if (icheckgrad.eq.1) then
1814 call vec_and_deriv_test
1821 cd write (iout,*) 'i=',i
1823 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1826 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1827 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1840 cd print '(a)','Enter EELEC'
1841 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1843 gel_loc_loc(i)=0.0d0
1846 do i=iatel_s,iatel_e
1847 if (itel(i).eq.0) goto 1215
1851 dx_normi=dc_norm(1,i)
1852 dy_normi=dc_norm(2,i)
1853 dz_normi=dc_norm(3,i)
1854 xmedi=c(1,i)+0.5d0*dxi
1855 ymedi=c(2,i)+0.5d0*dyi
1856 zmedi=c(3,i)+0.5d0*dzi
1858 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1859 do j=ielstart(i),ielend(i)
1860 if (itel(j).eq.0) goto 1216
1864 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1865 aaa=app(iteli,itelj)
1866 bbb=bpp(iteli,itelj)
1867 C Diagnostics only!!!
1873 ael6i=ael6(iteli,itelj)
1874 ael3i=ael3(iteli,itelj)
1878 dx_normj=dc_norm(1,j)
1879 dy_normj=dc_norm(2,j)
1880 dz_normj=dc_norm(3,j)
1881 xj=c(1,j)+0.5D0*dxj-xmedi
1882 yj=c(2,j)+0.5D0*dyj-ymedi
1883 zj=c(3,j)+0.5D0*dzj-zmedi
1884 rij=xj*xj+yj*yj+zj*zj
1890 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1891 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1892 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1893 fac=cosa-3.0D0*cosb*cosg
1895 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1896 if (j.eq.i+2) ev1=scal_el*ev1
1901 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1904 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1905 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1906 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1909 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1910 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1911 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1912 cd & xmedi,ymedi,zmedi,xj,yj,zj
1914 C Calculate contributions to the Cartesian gradient.
1917 facvdw=-6*rrmij*(ev1+evdwij)
1918 facel=-3*rrmij*(el1+eesij)
1925 * Radial derivatives. First process both termini of the fragment (i,j)
1932 gelc(k,i)=gelc(k,i)+ghalf
1933 gelc(k,j)=gelc(k,j)+ghalf
1936 * Loop over residues i+1 thru j-1.
1940 gelc(l,k)=gelc(l,k)+ggg(l)
1948 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1949 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1952 * Loop over residues i+1 thru j-1.
1956 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1963 fac=-3*rrmij*(facvdw+facvdw+facel)
1969 * Radial derivatives. First process both termini of the fragment (i,j)
1976 gelc(k,i)=gelc(k,i)+ghalf
1977 gelc(k,j)=gelc(k,j)+ghalf
1980 * Loop over residues i+1 thru j-1.
1984 gelc(l,k)=gelc(l,k)+ggg(l)
1991 ecosa=2.0D0*fac3*fac1+fac4
1994 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1995 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1997 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1998 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2000 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2001 cd & (dcosg(k),k=1,3)
2003 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2007 gelc(k,i)=gelc(k,i)+ghalf
2008 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2009 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2010 gelc(k,j)=gelc(k,j)+ghalf
2011 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2012 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2016 gelc(l,k)=gelc(l,k)+ggg(l)
2021 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2022 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2023 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2025 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2026 C energy of a peptide unit is assumed in the form of a second-order
2027 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2028 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2029 C are computed for EVERY pair of non-contiguous peptide groups.
2031 if (j.lt.nres-1) then
2042 muij(kkk)=mu(k,i)*mu(l,j)
2045 cd write (iout,*) 'EELEC: i',i,' j',j
2046 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2047 cd write(iout,*) 'muij',muij
2048 ury=scalar(uy(1,i),erij)
2049 urz=scalar(uz(1,i),erij)
2050 vry=scalar(uy(1,j),erij)
2051 vrz=scalar(uz(1,j),erij)
2052 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2053 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2054 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2055 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2056 C For diagnostics only
2061 fac=dsqrt(-ael6i)*r3ij
2062 cd write (2,*) 'fac=',fac
2063 C For diagnostics only
2069 cd write (iout,'(4i5,4f10.5)')
2070 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2071 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2072 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2073 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2074 cd write (iout,'(4f10.5)')
2075 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2076 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2077 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2078 cd write (iout,'(2i3,9f10.5/)') i,j,
2079 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2081 C Derivatives of the elements of A in virtual-bond vectors
2082 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2089 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2090 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2091 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2092 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2093 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2094 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2095 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2096 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2097 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2098 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2099 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2100 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2110 C Compute radial contributions to the gradient
2132 C Add the contributions coming from er
2135 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2136 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2137 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2138 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2141 C Derivatives in DC(i)
2142 ghalf1=0.5d0*agg(k,1)
2143 ghalf2=0.5d0*agg(k,2)
2144 ghalf3=0.5d0*agg(k,3)
2145 ghalf4=0.5d0*agg(k,4)
2146 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2147 & -3.0d0*uryg(k,2)*vry)+ghalf1
2148 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2149 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2150 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2151 & -3.0d0*urzg(k,2)*vry)+ghalf3
2152 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2153 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2154 C Derivatives in DC(i+1)
2155 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2156 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2157 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2158 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2159 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2160 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2161 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2162 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2163 C Derivatives in DC(j)
2164 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2165 & -3.0d0*vryg(k,2)*ury)+ghalf1
2166 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2167 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2168 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2169 & -3.0d0*vryg(k,2)*urz)+ghalf3
2170 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2171 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2172 C Derivatives in DC(j+1) or DC(nres-1)
2173 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2174 & -3.0d0*vryg(k,3)*ury)
2175 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2176 & -3.0d0*vrzg(k,3)*ury)
2177 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2178 & -3.0d0*vryg(k,3)*urz)
2179 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2180 & -3.0d0*vrzg(k,3)*urz)
2185 C Derivatives in DC(i+1)
2186 cd aggi1(k,1)=agg(k,1)
2187 cd aggi1(k,2)=agg(k,2)
2188 cd aggi1(k,3)=agg(k,3)
2189 cd aggi1(k,4)=agg(k,4)
2190 C Derivatives in DC(j)
2195 C Derivatives in DC(j+1)
2200 if (j.eq.nres-1 .and. i.lt.j-2) then
2202 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2203 cd aggj1(k,l)=agg(k,l)
2209 C Check the loc-el terms by numerical integration
2219 aggi(k,l)=-aggi(k,l)
2220 aggi1(k,l)=-aggi1(k,l)
2221 aggj(k,l)=-aggj(k,l)
2222 aggj1(k,l)=-aggj1(k,l)
2225 if (j.lt.nres-1) then
2231 aggi(k,l)=-aggi(k,l)
2232 aggi1(k,l)=-aggi1(k,l)
2233 aggj(k,l)=-aggj(k,l)
2234 aggj1(k,l)=-aggj1(k,l)
2245 aggi(k,l)=-aggi(k,l)
2246 aggi1(k,l)=-aggi1(k,l)
2247 aggj(k,l)=-aggj(k,l)
2248 aggj1(k,l)=-aggj1(k,l)
2254 IF (wel_loc.gt.0.0d0) THEN
2255 C Contribution to the local-electrostatic energy coming from the i-j pair
2256 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2258 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2259 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2260 eel_loc=eel_loc+eel_loc_ij
2261 C Partial derivatives in virtual-bond dihedral angles gamma
2264 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2265 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2266 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2267 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2268 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2269 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2270 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2271 cd write(iout,*) 'agg ',agg
2272 cd write(iout,*) 'aggi ',aggi
2273 cd write(iout,*) 'aggi1',aggi1
2274 cd write(iout,*) 'aggj ',aggj
2275 cd write(iout,*) 'aggj1',aggj1
2277 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2279 ggg(l)=agg(l,1)*muij(1)+
2280 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2284 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2287 C Remaining derivatives of eello
2289 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2290 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2291 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2292 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2293 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2294 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2295 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2296 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2300 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2301 C Contributions from turns
2306 call eturn34(i,j,eello_turn3,eello_turn4)
2308 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2309 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2311 C Calculate the contact function. The ith column of the array JCONT will
2312 C contain the numbers of atoms that make contacts with the atom I (of numbers
2313 C greater than I). The arrays FACONT and GACONT will contain the values of
2314 C the contact function and its derivative.
2315 c r0ij=1.02D0*rpp(iteli,itelj)
2316 c r0ij=1.11D0*rpp(iteli,itelj)
2317 r0ij=2.20D0*rpp(iteli,itelj)
2318 c r0ij=1.55D0*rpp(iteli,itelj)
2319 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2320 if (fcont.gt.0.0D0) then
2321 num_conti=num_conti+1
2322 if (num_conti.gt.maxconts) then
2323 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2324 & ' will skip next contacts for this conf.'
2326 jcont_hb(num_conti,i)=j
2327 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2328 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2329 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2331 d_cont(num_conti,i)=rij
2332 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2333 C --- Electrostatic-interaction matrix ---
2334 a_chuj(1,1,num_conti,i)=a22
2335 a_chuj(1,2,num_conti,i)=a23
2336 a_chuj(2,1,num_conti,i)=a32
2337 a_chuj(2,2,num_conti,i)=a33
2338 C --- Gradient of rij
2340 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2343 c a_chuj(1,1,num_conti,i)=-0.61d0
2344 c a_chuj(1,2,num_conti,i)= 0.4d0
2345 c a_chuj(2,1,num_conti,i)= 0.65d0
2346 c a_chuj(2,2,num_conti,i)= 0.50d0
2347 c else if (i.eq.2) then
2348 c a_chuj(1,1,num_conti,i)= 0.0d0
2349 c a_chuj(1,2,num_conti,i)= 0.0d0
2350 c a_chuj(2,1,num_conti,i)= 0.0d0
2351 c a_chuj(2,2,num_conti,i)= 0.0d0
2353 C --- and its gradients
2354 cd write (iout,*) 'i',i,' j',j
2356 cd write (iout,*) 'iii 1 kkk',kkk
2357 cd write (iout,*) agg(kkk,:)
2360 cd write (iout,*) 'iii 2 kkk',kkk
2361 cd write (iout,*) aggi(kkk,:)
2364 cd write (iout,*) 'iii 3 kkk',kkk
2365 cd write (iout,*) aggi1(kkk,:)
2368 cd write (iout,*) 'iii 4 kkk',kkk
2369 cd write (iout,*) aggj(kkk,:)
2372 cd write (iout,*) 'iii 5 kkk',kkk
2373 cd write (iout,*) aggj1(kkk,:)
2380 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2381 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2382 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2383 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2384 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2386 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2392 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2393 C Calculate contact energies
2395 wij=cosa-3.0D0*cosb*cosg
2398 c fac3=dsqrt(-ael6i)/r0ij**3
2399 fac3=dsqrt(-ael6i)*r3ij
2400 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2401 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2403 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2404 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2405 C Diagnostics. Comment out or remove after debugging!
2406 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2407 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2408 c ees0m(num_conti,i)=0.0D0
2410 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2411 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2412 facont_hb(num_conti,i)=fcont
2414 C Angular derivatives of the contact function
2415 ees0pij1=fac3/ees0pij
2416 ees0mij1=fac3/ees0mij
2417 fac3p=-3.0D0*fac3*rrmij
2418 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2419 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2421 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2422 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2423 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2424 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2425 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2426 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2427 ecosap=ecosa1+ecosa2
2428 ecosbp=ecosb1+ecosb2
2429 ecosgp=ecosg1+ecosg2
2430 ecosam=ecosa1-ecosa2
2431 ecosbm=ecosb1-ecosb2
2432 ecosgm=ecosg1-ecosg2
2441 fprimcont=fprimcont/rij
2442 cd facont_hb(num_conti,i)=1.0D0
2443 C Following line is for diagnostics.
2446 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2447 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2450 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2451 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2453 gggp(1)=gggp(1)+ees0pijp*xj
2454 gggp(2)=gggp(2)+ees0pijp*yj
2455 gggp(3)=gggp(3)+ees0pijp*zj
2456 gggm(1)=gggm(1)+ees0mijp*xj
2457 gggm(2)=gggm(2)+ees0mijp*yj
2458 gggm(3)=gggm(3)+ees0mijp*zj
2459 C Derivatives due to the contact function
2460 gacont_hbr(1,num_conti,i)=fprimcont*xj
2461 gacont_hbr(2,num_conti,i)=fprimcont*yj
2462 gacont_hbr(3,num_conti,i)=fprimcont*zj
2464 ghalfp=0.5D0*gggp(k)
2465 ghalfm=0.5D0*gggm(k)
2466 gacontp_hb1(k,num_conti,i)=ghalfp
2467 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2468 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2469 gacontp_hb2(k,num_conti,i)=ghalfp
2470 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2471 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2472 gacontp_hb3(k,num_conti,i)=gggp(k)
2473 gacontm_hb1(k,num_conti,i)=ghalfm
2474 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2475 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2476 gacontm_hb2(k,num_conti,i)=ghalfm
2477 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2478 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2479 gacontm_hb3(k,num_conti,i)=gggm(k)
2482 C Diagnostics. Comment out or remove after debugging!
2484 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2485 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2486 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2487 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2488 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2489 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2492 endif ! num_conti.le.maxconts
2497 num_cont_hb(i)=num_conti
2501 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2502 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2504 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2505 ccc eel_loc=eel_loc+eello_turn3
2508 C-----------------------------------------------------------------------------
2509 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2510 C Third- and fourth-order contributions from turns
2511 implicit real*8 (a-h,o-z)
2512 include 'DIMENSIONS'
2513 include 'DIMENSIONS.ZSCOPT'
2514 include 'COMMON.IOUNITS'
2515 include 'COMMON.GEO'
2516 include 'COMMON.VAR'
2517 include 'COMMON.LOCAL'
2518 include 'COMMON.CHAIN'
2519 include 'COMMON.DERIV'
2520 include 'COMMON.INTERACT'
2521 include 'COMMON.CONTACTS'
2522 include 'COMMON.TORSION'
2523 include 'COMMON.VECTORS'
2524 include 'COMMON.FFIELD'
2526 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2527 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2528 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2529 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2530 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2531 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2533 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2535 C Third-order contributions
2542 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2543 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2544 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2545 call transpose2(auxmat(1,1),auxmat1(1,1))
2546 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2547 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2548 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2549 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2550 cd & ' eello_turn3_num',4*eello_turn3_num
2552 C Derivatives in gamma(i)
2553 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2554 call transpose2(auxmat2(1,1),pizda(1,1))
2555 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2556 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2557 C Derivatives in gamma(i+1)
2558 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2559 call transpose2(auxmat2(1,1),pizda(1,1))
2560 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2561 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2562 & +0.5d0*(pizda(1,1)+pizda(2,2))
2563 C Cartesian derivatives
2565 a_temp(1,1)=aggi(l,1)
2566 a_temp(1,2)=aggi(l,2)
2567 a_temp(2,1)=aggi(l,3)
2568 a_temp(2,2)=aggi(l,4)
2569 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2570 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2571 & +0.5d0*(pizda(1,1)+pizda(2,2))
2572 a_temp(1,1)=aggi1(l,1)
2573 a_temp(1,2)=aggi1(l,2)
2574 a_temp(2,1)=aggi1(l,3)
2575 a_temp(2,2)=aggi1(l,4)
2576 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2577 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2578 & +0.5d0*(pizda(1,1)+pizda(2,2))
2579 a_temp(1,1)=aggj(l,1)
2580 a_temp(1,2)=aggj(l,2)
2581 a_temp(2,1)=aggj(l,3)
2582 a_temp(2,2)=aggj(l,4)
2583 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2584 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2585 & +0.5d0*(pizda(1,1)+pizda(2,2))
2586 a_temp(1,1)=aggj1(l,1)
2587 a_temp(1,2)=aggj1(l,2)
2588 a_temp(2,1)=aggj1(l,3)
2589 a_temp(2,2)=aggj1(l,4)
2590 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2591 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2592 & +0.5d0*(pizda(1,1)+pizda(2,2))
2595 else if (j.eq.i+3) then
2596 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2598 C Fourth-order contributions
2606 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2607 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2608 iti1=itortyp(itype(i+1))
2609 iti2=itortyp(itype(i+2))
2610 iti3=itortyp(itype(i+3))
2611 call transpose2(EUg(1,1,i+1),e1t(1,1))
2612 call transpose2(Eug(1,1,i+2),e2t(1,1))
2613 call transpose2(Eug(1,1,i+3),e3t(1,1))
2614 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2615 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2616 s1=scalar2(b1(1,iti2),auxvec(1))
2617 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2618 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2619 s2=scalar2(b1(1,iti1),auxvec(1))
2620 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2621 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2622 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2623 eello_turn4=eello_turn4-(s1+s2+s3)
2624 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2625 cd & ' eello_turn4_num',8*eello_turn4_num
2626 C Derivatives in gamma(i)
2628 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2629 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2630 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2631 s1=scalar2(b1(1,iti2),auxvec(1))
2632 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2633 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2634 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2635 C Derivatives in gamma(i+1)
2636 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2637 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2638 s2=scalar2(b1(1,iti1),auxvec(1))
2639 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2640 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2641 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2642 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2643 C Derivatives in gamma(i+2)
2644 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2645 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2646 s1=scalar2(b1(1,iti2),auxvec(1))
2647 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2648 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2649 s2=scalar2(b1(1,iti1),auxvec(1))
2650 call matmat2(auxmat(1,1),e2t(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+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2654 C Cartesian derivatives
2655 C Derivatives of this turn contributions in DC(i+2)
2656 if (j.lt.nres-1) then
2658 a_temp(1,1)=agg(l,1)
2659 a_temp(1,2)=agg(l,2)
2660 a_temp(2,1)=agg(l,3)
2661 a_temp(2,2)=agg(l,4)
2662 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2663 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2664 s1=scalar2(b1(1,iti2),auxvec(1))
2665 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2666 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2667 s2=scalar2(b1(1,iti1),auxvec(1))
2668 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2669 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2670 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2672 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2675 C Remaining derivatives of this turn contribution
2677 a_temp(1,1)=aggi(l,1)
2678 a_temp(1,2)=aggi(l,2)
2679 a_temp(2,1)=aggi(l,3)
2680 a_temp(2,2)=aggi(l,4)
2681 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2682 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2683 s1=scalar2(b1(1,iti2),auxvec(1))
2684 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2685 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2686 s2=scalar2(b1(1,iti1),auxvec(1))
2687 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2688 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2689 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2690 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2691 a_temp(1,1)=aggi1(l,1)
2692 a_temp(1,2)=aggi1(l,2)
2693 a_temp(2,1)=aggi1(l,3)
2694 a_temp(2,2)=aggi1(l,4)
2695 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2696 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2697 s1=scalar2(b1(1,iti2),auxvec(1))
2698 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2699 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2700 s2=scalar2(b1(1,iti1),auxvec(1))
2701 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2702 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2703 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2704 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2705 a_temp(1,1)=aggj(l,1)
2706 a_temp(1,2)=aggj(l,2)
2707 a_temp(2,1)=aggj(l,3)
2708 a_temp(2,2)=aggj(l,4)
2709 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2710 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2711 s1=scalar2(b1(1,iti2),auxvec(1))
2712 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2713 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2714 s2=scalar2(b1(1,iti1),auxvec(1))
2715 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2716 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2717 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2718 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2719 a_temp(1,1)=aggj1(l,1)
2720 a_temp(1,2)=aggj1(l,2)
2721 a_temp(2,1)=aggj1(l,3)
2722 a_temp(2,2)=aggj1(l,4)
2723 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2724 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2725 s1=scalar2(b1(1,iti2),auxvec(1))
2726 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2727 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2728 s2=scalar2(b1(1,iti1),auxvec(1))
2729 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2730 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2731 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2732 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2738 C-----------------------------------------------------------------------------
2739 subroutine vecpr(u,v,w)
2740 implicit real*8(a-h,o-z)
2741 dimension u(3),v(3),w(3)
2742 w(1)=u(2)*v(3)-u(3)*v(2)
2743 w(2)=-u(1)*v(3)+u(3)*v(1)
2744 w(3)=u(1)*v(2)-u(2)*v(1)
2747 C-----------------------------------------------------------------------------
2748 subroutine unormderiv(u,ugrad,unorm,ungrad)
2749 C This subroutine computes the derivatives of a normalized vector u, given
2750 C the derivatives computed without normalization conditions, ugrad. Returns
2753 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2754 double precision vec(3)
2755 double precision scalar
2757 c write (2,*) 'ugrad',ugrad
2760 vec(i)=scalar(ugrad(1,i),u(1))
2762 c write (2,*) 'vec',vec
2765 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2768 c write (2,*) 'ungrad',ungrad
2771 C-----------------------------------------------------------------------------
2772 subroutine escp(evdw2,evdw2_14)
2774 C This subroutine calculates the excluded-volume interaction energy between
2775 C peptide-group centers and side chains and its gradient in virtual-bond and
2776 C side-chain vectors.
2778 implicit real*8 (a-h,o-z)
2779 include 'DIMENSIONS'
2780 include 'DIMENSIONS.ZSCOPT'
2781 include 'COMMON.GEO'
2782 include 'COMMON.VAR'
2783 include 'COMMON.LOCAL'
2784 include 'COMMON.CHAIN'
2785 include 'COMMON.DERIV'
2786 include 'COMMON.INTERACT'
2787 include 'COMMON.FFIELD'
2788 include 'COMMON.IOUNITS'
2792 cd print '(a)','Enter ESCP'
2793 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2794 c & ' scal14',scal14
2795 do i=iatscp_s,iatscp_e
2797 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2798 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2799 if (iteli.eq.0) goto 1225
2800 xi=0.5D0*(c(1,i)+c(1,i+1))
2801 yi=0.5D0*(c(2,i)+c(2,i+1))
2802 zi=0.5D0*(c(3,i)+c(3,i+1))
2804 do iint=1,nscp_gr(i)
2806 do j=iscpstart(i,iint),iscpend(i,iint)
2808 C Uncomment following three lines for SC-p interactions
2812 C Uncomment following three lines for Ca-p interactions
2816 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2818 e1=fac*fac*aad(itypj,iteli)
2819 e2=fac*bad(itypj,iteli)
2820 if (iabs(j-i) .le. 2) then
2823 evdw2_14=evdw2_14+e1+e2
2826 c write (iout,*) i,j,evdwij
2830 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2832 fac=-(evdwij+e1)*rrij
2837 cd write (iout,*) 'j<i'
2838 C Uncomment following three lines for SC-p interactions
2840 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2843 cd write (iout,*) 'j>i'
2846 C Uncomment following line for SC-p interactions
2847 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2851 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2855 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2856 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2859 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2869 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2870 gradx_scp(j,i)=expon*gradx_scp(j,i)
2873 C******************************************************************************
2877 C To save time the factor EXPON has been extracted from ALL components
2878 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2881 C******************************************************************************
2884 C--------------------------------------------------------------------------
2885 subroutine edis(ehpb)
2887 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2889 implicit real*8 (a-h,o-z)
2890 include 'DIMENSIONS'
2891 include 'COMMON.SBRIDGE'
2892 include 'COMMON.CHAIN'
2893 include 'COMMON.DERIV'
2894 include 'COMMON.VAR'
2895 include 'COMMON.INTERACT'
2896 include 'COMMON.IOUNITS'
2899 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
2900 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
2901 if (link_end.eq.0) return
2902 do i=link_start,link_end
2903 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2904 C CA-CA distance used in regularization of structure.
2907 C iii and jjj point to the residues for which the distance is assigned.
2908 if (ii.gt.nres) then
2915 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
2916 c & dhpb(i),dhpb1(i),forcon(i)
2917 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2918 C distance and angle dependent SS bond potential.
2919 if (.not.dyn_ss .and. i.le.nss) then
2920 C 15/02/13 CC dynamic SSbond - additional check
2921 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2922 call ssbond_ene(iii,jjj,eij)
2925 cd write (iout,*) "eij",eij
2926 else if (ii.gt.nres .and. jj.gt.nres) then
2927 c Restraints from contact prediction
2929 if (dhpb1(i).gt.0.0d0) then
2930 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2931 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2932 c write (iout,*) "beta nmr",
2933 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2937 C Get the force constant corresponding to this distance.
2939 C Calculate the contribution to energy.
2940 ehpb=ehpb+waga*rdis*rdis
2941 c write (iout,*) "beta reg",dd,waga*rdis*rdis
2943 C Evaluate gradient.
2948 ggg(j)=fac*(c(j,jj)-c(j,ii))
2951 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2952 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2955 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2956 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
2959 C Calculate the distance between the two points and its difference from the
2962 if (dhpb1(i).gt.0.0d0) then
2963 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2964 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2965 c write (iout,*) "alph nmr",
2966 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2969 C Get the force constant corresponding to this distance.
2971 C Calculate the contribution to energy.
2972 ehpb=ehpb+waga*rdis*rdis
2973 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
2975 C Evaluate gradient.
2979 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2980 cd & ' waga=',waga,' fac=',fac
2982 ggg(j)=fac*(c(j,jj)-c(j,ii))
2984 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2985 C If this is a SC-SC distance, we need to calculate the contributions to the
2986 C Cartesian gradient in the SC vectors (ghpbx).
2989 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2990 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2994 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
2995 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3002 C--------------------------------------------------------------------------
3003 subroutine ssbond_ene(i,j,eij)
3005 C Calculate the distance and angle dependent SS-bond potential energy
3006 C using a free-energy function derived based on RHF/6-31G** ab initio
3007 C calculations of diethyl disulfide.
3009 C A. Liwo and U. Kozlowska, 11/24/03
3011 implicit real*8 (a-h,o-z)
3012 include 'DIMENSIONS'
3013 include 'DIMENSIONS.ZSCOPT'
3014 include 'COMMON.SBRIDGE'
3015 include 'COMMON.CHAIN'
3016 include 'COMMON.DERIV'
3017 include 'COMMON.LOCAL'
3018 include 'COMMON.INTERACT'
3019 include 'COMMON.VAR'
3020 include 'COMMON.IOUNITS'
3021 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3026 dxi=dc_norm(1,nres+i)
3027 dyi=dc_norm(2,nres+i)
3028 dzi=dc_norm(3,nres+i)
3029 dsci_inv=dsc_inv(itypi)
3031 dscj_inv=dsc_inv(itypj)
3035 dxj=dc_norm(1,nres+j)
3036 dyj=dc_norm(2,nres+j)
3037 dzj=dc_norm(3,nres+j)
3038 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3043 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3044 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3045 om12=dxi*dxj+dyi*dyj+dzi*dzj
3047 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3048 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3054 deltat12=om2-om1+2.0d0
3056 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3057 & +akct*deltad*deltat12+ebr
3058 c & +akct*deltad*deltat12
3059 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3060 write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3061 & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3062 & " deltat12",deltat12," eij",eij,"ebr",ebr
3063 ed=2*akcm*deltad+akct*deltat12
3065 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3066 eom1=-2*akth*deltat1-pom1-om2*pom2
3067 eom2= 2*akth*deltat2+pom1-om1*pom2
3070 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3073 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3074 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3075 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3076 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3079 C Calculate the components of the gradient in DC and X
3083 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3088 C--------------------------------------------------------------------------
3089 subroutine ebond(estr)
3091 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3093 implicit real*8 (a-h,o-z)
3094 include 'DIMENSIONS'
3095 include 'DIMENSIONS.ZSCOPT'
3096 include 'COMMON.LOCAL'
3097 include 'COMMON.GEO'
3098 include 'COMMON.INTERACT'
3099 include 'COMMON.DERIV'
3100 include 'COMMON.VAR'
3101 include 'COMMON.CHAIN'
3102 include 'COMMON.IOUNITS'
3103 include 'COMMON.NAMES'
3104 include 'COMMON.FFIELD'
3105 include 'COMMON.CONTROL'
3106 double precision u(3),ud(3)
3107 logical :: lprn=.false.
3110 diff = vbld(i)-vbldp0
3111 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3114 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3119 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3126 diff=vbld(i+nres)-vbldsc0(1,iti)
3128 & write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3129 & AKSC(1,iti),AKSC(1,iti)*diff*diff
3130 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3132 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3136 diff=vbld(i+nres)-vbldsc0(j,iti)
3137 ud(j)=aksc(j,iti)*diff
3138 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3152 uprod2=uprod2*u(k)*u(k)
3156 usumsqder=usumsqder+ud(j)*uprod2
3159 & write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3160 & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3161 estr=estr+uprod/usum
3163 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3171 C--------------------------------------------------------------------------
3172 subroutine ebend(etheta)
3174 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3175 C angles gamma and its derivatives in consecutive thetas and gammas.
3177 implicit real*8 (a-h,o-z)
3178 include 'DIMENSIONS'
3179 include 'DIMENSIONS.ZSCOPT'
3180 include 'COMMON.LOCAL'
3181 include 'COMMON.GEO'
3182 include 'COMMON.INTERACT'
3183 include 'COMMON.DERIV'
3184 include 'COMMON.VAR'
3185 include 'COMMON.CHAIN'
3186 include 'COMMON.IOUNITS'
3187 include 'COMMON.NAMES'
3188 include 'COMMON.FFIELD'
3189 common /calcthet/ term1,term2,termm,diffak,ratak,
3190 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3191 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3192 double precision y(2),z(2)
3194 time11=dexp(-2*time)
3197 c write (iout,*) "nres",nres
3198 c write (*,'(a,i2)') 'EBEND ICG=',icg
3199 c write (iout,*) ithet_start,ithet_end
3200 do i=ithet_start,ithet_end
3201 C Zero the energy function and its derivative at 0 or pi.
3202 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3204 c if (i.gt.ithet_start .and.
3205 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
3206 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
3214 c if (i.lt.nres .and. itel(i).ne.0) then
3226 call proc_proc(phii,icrc)
3227 if (icrc.eq.1) phii=150.0
3241 call proc_proc(phii1,icrc)
3242 if (icrc.eq.1) phii1=150.0
3254 C Calculate the "mean" value of theta from the part of the distribution
3255 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3256 C In following comments this theta will be referred to as t_c.
3257 thet_pred_mean=0.0d0
3261 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3263 c write (iout,*) "thet_pred_mean",thet_pred_mean
3264 dthett=thet_pred_mean*ssd
3265 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3266 c write (iout,*) "thet_pred_mean",thet_pred_mean
3267 C Derivatives of the "mean" values in gamma1 and gamma2.
3268 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3269 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3270 if (theta(i).gt.pi-delta) then
3271 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3273 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3274 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3275 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3277 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3279 else if (theta(i).lt.delta) then
3280 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3281 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3282 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3284 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3285 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3288 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3291 etheta=etheta+ethetai
3292 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3293 c & rad2deg*phii,rad2deg*phii1,ethetai
3294 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3295 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3296 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3299 C Ufff.... We've done all this!!!
3302 C---------------------------------------------------------------------------
3303 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3305 implicit real*8 (a-h,o-z)
3306 include 'DIMENSIONS'
3307 include 'COMMON.LOCAL'
3308 include 'COMMON.IOUNITS'
3309 common /calcthet/ term1,term2,termm,diffak,ratak,
3310 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3311 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3312 C Calculate the contributions to both Gaussian lobes.
3313 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3314 C The "polynomial part" of the "standard deviation" of this part of
3318 sig=sig*thet_pred_mean+polthet(j,it)
3320 C Derivative of the "interior part" of the "standard deviation of the"
3321 C gamma-dependent Gaussian lobe in t_c.
3322 sigtc=3*polthet(3,it)
3324 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3327 C Set the parameters of both Gaussian lobes of the distribution.
3328 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3329 fac=sig*sig+sigc0(it)
3332 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3333 sigsqtc=-4.0D0*sigcsq*sigtc
3334 c print *,i,sig,sigtc,sigsqtc
3335 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3336 sigtc=-sigtc/(fac*fac)
3337 C Following variable is sigma(t_c)**(-2)
3338 sigcsq=sigcsq*sigcsq
3340 sig0inv=1.0D0/sig0i**2
3341 delthec=thetai-thet_pred_mean
3342 delthe0=thetai-theta0i
3343 term1=-0.5D0*sigcsq*delthec*delthec
3344 term2=-0.5D0*sig0inv*delthe0*delthe0
3345 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3346 C NaNs in taking the logarithm. We extract the largest exponent which is added
3347 C to the energy (this being the log of the distribution) at the end of energy
3348 C term evaluation for this virtual-bond angle.
3349 if (term1.gt.term2) then
3351 term2=dexp(term2-termm)
3355 term1=dexp(term1-termm)
3358 C The ratio between the gamma-independent and gamma-dependent lobes of
3359 C the distribution is a Gaussian function of thet_pred_mean too.
3360 diffak=gthet(2,it)-thet_pred_mean
3361 ratak=diffak/gthet(3,it)**2
3362 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3363 C Let's differentiate it in thet_pred_mean NOW.
3365 C Now put together the distribution terms to make complete distribution.
3366 termexp=term1+ak*term2
3367 termpre=sigc+ak*sig0i
3368 C Contribution of the bending energy from this theta is just the -log of
3369 C the sum of the contributions from the two lobes and the pre-exponential
3370 C factor. Simple enough, isn't it?
3371 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3372 C NOW the derivatives!!!
3373 C 6/6/97 Take into account the deformation.
3374 E_theta=(delthec*sigcsq*term1
3375 & +ak*delthe0*sig0inv*term2)/termexp
3376 E_tc=((sigtc+aktc*sig0i)/termpre
3377 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3378 & aktc*term2)/termexp)
3381 c-----------------------------------------------------------------------------
3382 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3383 implicit real*8 (a-h,o-z)
3384 include 'DIMENSIONS'
3385 include 'COMMON.LOCAL'
3386 include 'COMMON.IOUNITS'
3387 common /calcthet/ term1,term2,termm,diffak,ratak,
3388 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3389 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3390 delthec=thetai-thet_pred_mean
3391 delthe0=thetai-theta0i
3392 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3393 t3 = thetai-thet_pred_mean
3397 t14 = t12+t6*sigsqtc
3399 t21 = thetai-theta0i
3405 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3406 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3407 & *(-t12*t9-ak*sig0inv*t27)
3411 C--------------------------------------------------------------------------
3412 subroutine ebend(etheta)
3414 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3415 C angles gamma and its derivatives in consecutive thetas and gammas.
3416 C ab initio-derived potentials from
3417 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3419 implicit real*8 (a-h,o-z)
3420 include 'DIMENSIONS'
3421 include 'DIMENSIONS.ZSCOPT'
3422 include 'COMMON.LOCAL'
3423 include 'COMMON.GEO'
3424 include 'COMMON.INTERACT'
3425 include 'COMMON.DERIV'
3426 include 'COMMON.VAR'
3427 include 'COMMON.CHAIN'
3428 include 'COMMON.IOUNITS'
3429 include 'COMMON.NAMES'
3430 include 'COMMON.FFIELD'
3431 include 'COMMON.CONTROL'
3432 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3433 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3434 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3435 & sinph1ph2(maxdouble,maxdouble)
3436 logical lprn /.false./, lprn1 /.false./
3438 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3439 do i=ithet_start,ithet_end
3440 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3441 &(itype(i).eq.ntyp1)) cycle
3445 theti2=0.5d0*theta(i)
3446 ityp2=ithetyp(itype(i-1))
3448 coskt(k)=dcos(k*theti2)
3449 sinkt(k)=dsin(k*theti2)
3451 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
3454 if (phii.ne.phii) phii=150.0
3458 ityp1=ithetyp(itype(i-2))
3460 cosph1(k)=dcos(k*phii)
3461 sinph1(k)=dsin(k*phii)
3465 ityp1=ithetyp(itype(i-2))
3471 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3474 if (phii1.ne.phii1) phii1=150.0
3479 ityp3=ithetyp(itype(i))
3481 cosph2(k)=dcos(k*phii1)
3482 sinph2(k)=dsin(k*phii1)
3486 ityp3=ithetyp(itype(i))
3492 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3493 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3495 ethetai=aa0thet(ityp1,ityp2,ityp3)
3498 ccl=cosph1(l)*cosph2(k-l)
3499 ssl=sinph1(l)*sinph2(k-l)
3500 scl=sinph1(l)*cosph2(k-l)
3501 csl=cosph1(l)*sinph2(k-l)
3502 cosph1ph2(l,k)=ccl-ssl
3503 cosph1ph2(k,l)=ccl+ssl
3504 sinph1ph2(l,k)=scl+csl
3505 sinph1ph2(k,l)=scl-csl
3509 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3510 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3511 write (iout,*) "coskt and sinkt"
3513 write (iout,*) k,coskt(k),sinkt(k)
3517 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3518 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3521 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3522 & " ethetai",ethetai
3525 write (iout,*) "cosph and sinph"
3527 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3529 write (iout,*) "cosph1ph2 and sinph2ph2"
3532 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3533 & sinph1ph2(l,k),sinph1ph2(k,l)
3536 write(iout,*) "ethetai",ethetai
3540 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3541 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3542 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3543 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3544 ethetai=ethetai+sinkt(m)*aux
3545 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3546 dephii=dephii+k*sinkt(m)*(
3547 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3548 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3549 dephii1=dephii1+k*sinkt(m)*(
3550 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3551 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3553 & write (iout,*) "m",m," k",k," bbthet",
3554 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3555 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3556 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3557 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3561 & write(iout,*) "ethetai",ethetai
3565 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3566 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3567 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3568 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3569 ethetai=ethetai+sinkt(m)*aux
3570 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3571 dephii=dephii+l*sinkt(m)*(
3572 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3573 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3574 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3575 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3576 dephii1=dephii1+(k-l)*sinkt(m)*(
3577 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3578 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3579 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3580 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3582 write (iout,*) "m",m," k",k," l",l," ffthet",
3583 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3584 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3585 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3586 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3587 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3588 & cosph1ph2(k,l)*sinkt(m),
3589 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3596 if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
3597 & 'ebe',i,theta(i)*rad2deg,phii*rad2deg,
3598 & phii1*rad2deg,ethetai
3600 etheta=etheta+ethetai
3602 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3603 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3604 gloc(nphi+i-2,icg)=wang*dethetai
3610 c-----------------------------------------------------------------------------
3611 subroutine esc(escloc)
3612 C Calculate the local energy of a side chain and its derivatives in the
3613 C corresponding virtual-bond valence angles THETA and the spherical angles
3615 implicit real*8 (a-h,o-z)
3616 include 'DIMENSIONS'
3617 include 'DIMENSIONS.ZSCOPT'
3618 include 'COMMON.GEO'
3619 include 'COMMON.LOCAL'
3620 include 'COMMON.VAR'
3621 include 'COMMON.INTERACT'
3622 include 'COMMON.DERIV'
3623 include 'COMMON.CHAIN'
3624 include 'COMMON.IOUNITS'
3625 include 'COMMON.NAMES'
3626 include 'COMMON.FFIELD'
3627 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3628 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3629 common /sccalc/ time11,time12,time112,theti,it,nlobit
3632 c write (iout,'(a)') 'ESC'
3633 do i=loc_start,loc_end
3635 if (it.eq.10) goto 1
3637 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3638 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3639 theti=theta(i+1)-pipol
3643 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3645 if (x(2).gt.pi-delta) then
3649 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3651 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3652 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3654 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3655 & ddersc0(1),dersc(1))
3656 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3657 & ddersc0(3),dersc(3))
3659 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3661 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3662 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3663 & dersc0(2),esclocbi,dersc02)
3664 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3666 call splinthet(x(2),0.5d0*delta,ss,ssd)
3671 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3673 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3674 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3676 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3678 c write (iout,*) escloci
3679 else if (x(2).lt.delta) then
3683 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3685 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3686 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3688 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3689 & ddersc0(1),dersc(1))
3690 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3691 & ddersc0(3),dersc(3))
3693 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3695 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3696 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3697 & dersc0(2),esclocbi,dersc02)
3698 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3703 call splinthet(x(2),0.5d0*delta,ss,ssd)
3705 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3707 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3708 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3710 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3711 c write (iout,*) escloci
3713 call enesc(x,escloci,dersc,ddummy,.false.)
3716 escloc=escloc+escloci
3717 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3719 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3721 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3722 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3727 C---------------------------------------------------------------------------
3728 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3729 implicit real*8 (a-h,o-z)
3730 include 'DIMENSIONS'
3731 include 'COMMON.GEO'
3732 include 'COMMON.LOCAL'
3733 include 'COMMON.IOUNITS'
3734 common /sccalc/ time11,time12,time112,theti,it,nlobit
3735 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3736 double precision contr(maxlob,-1:1)
3738 c write (iout,*) 'it=',it,' nlobit=',nlobit
3742 if (mixed) ddersc(j)=0.0d0
3746 C Because of periodicity of the dependence of the SC energy in omega we have
3747 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3748 C To avoid underflows, first compute & store the exponents.
3756 z(k)=x(k)-censc(k,j,it)
3761 Axk=Axk+gaussc(l,k,j,it)*z(l)
3767 expfac=expfac+Ax(k,j,iii)*z(k)
3775 C As in the case of ebend, we want to avoid underflows in exponentiation and
3776 C subsequent NaNs and INFs in energy calculation.
3777 C Find the largest exponent
3781 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3785 cd print *,'it=',it,' emin=',emin
3787 C Compute the contribution to SC energy and derivatives
3791 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3792 cd print *,'j=',j,' expfac=',expfac
3793 escloc_i=escloc_i+expfac
3795 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3799 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3800 & +gaussc(k,2,j,it))*expfac
3807 dersc(1)=dersc(1)/cos(theti)**2
3808 ddersc(1)=ddersc(1)/cos(theti)**2
3811 escloci=-(dlog(escloc_i)-emin)
3813 dersc(j)=dersc(j)/escloc_i
3817 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3822 C------------------------------------------------------------------------------
3823 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3824 implicit real*8 (a-h,o-z)
3825 include 'DIMENSIONS'
3826 include 'COMMON.GEO'
3827 include 'COMMON.LOCAL'
3828 include 'COMMON.IOUNITS'
3829 common /sccalc/ time11,time12,time112,theti,it,nlobit
3830 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3831 double precision contr(maxlob)
3842 z(k)=x(k)-censc(k,j,it)
3848 Axk=Axk+gaussc(l,k,j,it)*z(l)
3854 expfac=expfac+Ax(k,j)*z(k)
3859 C As in the case of ebend, we want to avoid underflows in exponentiation and
3860 C subsequent NaNs and INFs in energy calculation.
3861 C Find the largest exponent
3864 if (emin.gt.contr(j)) emin=contr(j)
3868 C Compute the contribution to SC energy and derivatives
3872 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3873 escloc_i=escloc_i+expfac
3875 dersc(k)=dersc(k)+Ax(k,j)*expfac
3877 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3878 & +gaussc(1,2,j,it))*expfac
3882 dersc(1)=dersc(1)/cos(theti)**2
3883 dersc12=dersc12/cos(theti)**2
3884 escloci=-(dlog(escloc_i)-emin)
3886 dersc(j)=dersc(j)/escloc_i
3888 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3892 c----------------------------------------------------------------------------------
3893 subroutine esc(escloc)
3894 C Calculate the local energy of a side chain and its derivatives in the
3895 C corresponding virtual-bond valence angles THETA and the spherical angles
3896 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3897 C added by Urszula Kozlowska. 07/11/2007
3899 implicit real*8 (a-h,o-z)
3900 include 'DIMENSIONS'
3901 include 'DIMENSIONS.ZSCOPT'
3902 include 'COMMON.GEO'
3903 include 'COMMON.LOCAL'
3904 include 'COMMON.VAR'
3905 include 'COMMON.SCROT'
3906 include 'COMMON.INTERACT'
3907 include 'COMMON.DERIV'
3908 include 'COMMON.CHAIN'
3909 include 'COMMON.IOUNITS'
3910 include 'COMMON.NAMES'
3911 include 'COMMON.FFIELD'
3912 include 'COMMON.CONTROL'
3913 include 'COMMON.VECTORS'
3914 double precision x_prime(3),y_prime(3),z_prime(3)
3915 & , sumene,dsc_i,dp2_i,x(65),
3916 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3917 & de_dxx,de_dyy,de_dzz,de_dt
3918 double precision s1_t,s1_6_t,s2_t,s2_6_t
3920 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3921 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3922 & dt_dCi(3),dt_dCi1(3)
3923 common /sccalc/ time11,time12,time112,theti,it,nlobit
3926 do i=loc_start,loc_end
3927 costtab(i+1) =dcos(theta(i+1))
3928 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3929 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3930 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3931 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3932 cosfac=dsqrt(cosfac2)
3933 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3934 sinfac=dsqrt(sinfac2)
3936 if (it.eq.10) goto 1
3938 C Compute the axes of tghe local cartesian coordinates system; store in
3939 c x_prime, y_prime and z_prime
3946 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3947 C & dc_norm(3,i+nres)
3949 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3950 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3953 z_prime(j) = -uz(j,i-1)
3956 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3957 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3958 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3959 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3960 c & " xy",scalar(x_prime(1),y_prime(1)),
3961 c & " xz",scalar(x_prime(1),z_prime(1)),
3962 c & " yy",scalar(y_prime(1),y_prime(1)),
3963 c & " yz",scalar(y_prime(1),z_prime(1)),
3964 c & " zz",scalar(z_prime(1),z_prime(1))
3966 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3967 C to local coordinate system. Store in xx, yy, zz.
3973 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3974 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3975 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3982 C Compute the energy of the ith side cbain
3984 c write (2,*) "xx",xx," yy",yy," zz",zz
3987 x(j) = sc_parmin(j,it)
3990 Cc diagnostics - remove later
3992 yy1 = dsin(alph(2))*dcos(omeg(2))
3993 zz1 = -dsin(alph(2))*dsin(omeg(2))
3994 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3995 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3997 C," --- ", xx_w,yy_w,zz_w
4000 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4001 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4003 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4004 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4006 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4007 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4008 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4009 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4010 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4012 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4013 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4014 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4015 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4016 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4018 dsc_i = 0.743d0+x(61)
4020 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4021 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4022 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4023 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4024 s1=(1+x(63))/(0.1d0 + dscp1)
4025 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4026 s2=(1+x(65))/(0.1d0 + dscp2)
4027 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4028 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4029 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4030 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4032 c & dscp1,dscp2,sumene
4033 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4034 escloc = escloc + sumene
4035 c write (2,*) "escloc",escloc
4036 if (.not. calc_grad) goto 1
4040 C This section to check the numerical derivatives of the energy of ith side
4041 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4042 C #define DEBUG in the code to turn it on.
4044 write (2,*) "sumene =",sumene
4048 write (2,*) xx,yy,zz
4049 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4050 de_dxx_num=(sumenep-sumene)/aincr
4052 write (2,*) "xx+ sumene from enesc=",sumenep
4055 write (2,*) xx,yy,zz
4056 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4057 de_dyy_num=(sumenep-sumene)/aincr
4059 write (2,*) "yy+ sumene from enesc=",sumenep
4062 write (2,*) xx,yy,zz
4063 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4064 de_dzz_num=(sumenep-sumene)/aincr
4066 write (2,*) "zz+ sumene from enesc=",sumenep
4067 costsave=cost2tab(i+1)
4068 sintsave=sint2tab(i+1)
4069 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4070 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4071 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4072 de_dt_num=(sumenep-sumene)/aincr
4073 write (2,*) " t+ sumene from enesc=",sumenep
4074 cost2tab(i+1)=costsave
4075 sint2tab(i+1)=sintsave
4076 C End of diagnostics section.
4079 C Compute the gradient of esc
4081 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4082 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4083 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4084 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4085 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4086 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4087 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4088 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4089 pom1=(sumene3*sint2tab(i+1)+sumene1)
4090 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4091 pom2=(sumene4*cost2tab(i+1)+sumene2)
4092 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4093 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4094 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4095 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4097 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4098 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4099 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4101 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4102 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4103 & +(pom1+pom2)*pom_dx
4105 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4108 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4109 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4110 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4112 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4113 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4114 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4115 & +x(59)*zz**2 +x(60)*xx*zz
4116 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4117 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4118 & +(pom1-pom2)*pom_dy
4120 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4123 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4124 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4125 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4126 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4127 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4128 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4129 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4130 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4132 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4135 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4136 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4137 & +pom1*pom_dt1+pom2*pom_dt2
4139 write(2,*), "de_dt = ", de_dt,de_dt_num
4143 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4144 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4145 cosfac2xx=cosfac2*xx
4146 sinfac2yy=sinfac2*yy
4148 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4150 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4152 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4153 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4154 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4155 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4156 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4157 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4158 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4159 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4160 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4161 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4165 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4166 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4169 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4170 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4171 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4173 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4174 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4178 dXX_Ctab(k,i)=dXX_Ci(k)
4179 dXX_C1tab(k,i)=dXX_Ci1(k)
4180 dYY_Ctab(k,i)=dYY_Ci(k)
4181 dYY_C1tab(k,i)=dYY_Ci1(k)
4182 dZZ_Ctab(k,i)=dZZ_Ci(k)
4183 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4184 dXX_XYZtab(k,i)=dXX_XYZ(k)
4185 dYY_XYZtab(k,i)=dYY_XYZ(k)
4186 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4190 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4191 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4192 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4193 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4194 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4196 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4197 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4198 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4199 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4200 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4201 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4202 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4203 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4205 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4206 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4208 C to check gradient call subroutine check_grad
4215 c------------------------------------------------------------------------------
4216 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4218 C This procedure calculates two-body contact function g(rij) and its derivative:
4221 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4224 C where x=(rij-r0ij)/delta
4226 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4229 double precision rij,r0ij,eps0ij,fcont,fprimcont
4230 double precision x,x2,x4,delta
4234 if (x.lt.-1.0D0) then
4237 else if (x.le.1.0D0) then
4240 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4241 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4248 c------------------------------------------------------------------------------
4249 subroutine splinthet(theti,delta,ss,ssder)
4250 implicit real*8 (a-h,o-z)
4251 include 'DIMENSIONS'
4252 include 'DIMENSIONS.ZSCOPT'
4253 include 'COMMON.VAR'
4254 include 'COMMON.GEO'
4257 if (theti.gt.pipol) then
4258 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4260 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4265 c------------------------------------------------------------------------------
4266 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4268 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4269 double precision ksi,ksi2,ksi3,a1,a2,a3
4270 a1=fprim0*delta/(f1-f0)
4276 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4277 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4280 c------------------------------------------------------------------------------
4281 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4283 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4284 double precision ksi,ksi2,ksi3,a1,a2,a3
4289 a2=3*(f1x-f0x)-2*fprim0x*delta
4290 a3=fprim0x*delta-2*(f1x-f0x)
4291 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4294 C-----------------------------------------------------------------------------
4296 C-----------------------------------------------------------------------------
4297 subroutine etor(etors,edihcnstr,fact)
4298 implicit real*8 (a-h,o-z)
4299 include 'DIMENSIONS'
4300 include 'DIMENSIONS.ZSCOPT'
4301 include 'COMMON.VAR'
4302 include 'COMMON.GEO'
4303 include 'COMMON.LOCAL'
4304 include 'COMMON.TORSION'
4305 include 'COMMON.INTERACT'
4306 include 'COMMON.DERIV'
4307 include 'COMMON.CHAIN'
4308 include 'COMMON.NAMES'
4309 include 'COMMON.IOUNITS'
4310 include 'COMMON.FFIELD'
4311 include 'COMMON.TORCNSTR'
4313 C Set lprn=.true. for debugging
4317 do i=iphi_start,iphi_end
4318 itori=itortyp(itype(i-2))
4319 itori1=itortyp(itype(i-1))
4322 C Proline-Proline pair is a special case...
4323 if (itori.eq.3 .and. itori1.eq.3) then
4324 if (phii.gt.-dwapi3) then
4326 fac=1.0D0/(1.0D0-cosphi)
4327 etorsi=v1(1,3,3)*fac
4328 etorsi=etorsi+etorsi
4329 etors=etors+etorsi-v1(1,3,3)
4330 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4333 v1ij=v1(j+1,itori,itori1)
4334 v2ij=v2(j+1,itori,itori1)
4337 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4338 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4342 v1ij=v1(j,itori,itori1)
4343 v2ij=v2(j,itori,itori1)
4346 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4347 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4351 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4352 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4353 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4354 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4355 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4357 ! 6/20/98 - dihedral angle constraints
4360 itori=idih_constr(i)
4363 if (difi.gt.drange(i)) then
4365 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4366 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4367 else if (difi.lt.-drange(i)) then
4369 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4370 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4372 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4373 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4375 ! write (iout,*) 'edihcnstr',edihcnstr
4378 c------------------------------------------------------------------------------
4380 subroutine etor(etors,edihcnstr,fact)
4381 implicit real*8 (a-h,o-z)
4382 include 'DIMENSIONS'
4383 include 'DIMENSIONS.ZSCOPT'
4384 include 'COMMON.VAR'
4385 include 'COMMON.GEO'
4386 include 'COMMON.LOCAL'
4387 include 'COMMON.TORSION'
4388 include 'COMMON.INTERACT'
4389 include 'COMMON.DERIV'
4390 include 'COMMON.CHAIN'
4391 include 'COMMON.NAMES'
4392 include 'COMMON.IOUNITS'
4393 include 'COMMON.FFIELD'
4394 include 'COMMON.TORCNSTR'
4396 C Set lprn=.true. for debugging
4400 do i=iphi_start,iphi_end
4401 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4402 itori=itortyp(itype(i-2))
4403 itori1=itortyp(itype(i-1))
4406 C Regular cosine and sine terms
4407 do j=1,nterm(itori,itori1)
4408 v1ij=v1(j,itori,itori1)
4409 v2ij=v2(j,itori,itori1)
4412 etors=etors+v1ij*cosphi+v2ij*sinphi
4413 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4417 C E = SUM ----------------------------------- - v1
4418 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4420 cosphi=dcos(0.5d0*phii)
4421 sinphi=dsin(0.5d0*phii)
4422 do j=1,nlor(itori,itori1)
4423 vl1ij=vlor1(j,itori,itori1)
4424 vl2ij=vlor2(j,itori,itori1)
4425 vl3ij=vlor3(j,itori,itori1)
4426 pom=vl2ij*cosphi+vl3ij*sinphi
4427 pom1=1.0d0/(pom*pom+1.0d0)
4428 etors=etors+vl1ij*pom1
4430 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4432 C Subtract the constant term
4433 etors=etors-v0(itori,itori1)
4435 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4436 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4437 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4438 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4439 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4442 ! 6/20/98 - dihedral angle constraints
4445 itori=idih_constr(i)
4447 difi=pinorm(phii-phi0(i))
4449 if (difi.gt.drange(i)) then
4451 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4452 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4453 edihi=0.25d0*ftors*difi**4
4454 else if (difi.lt.-drange(i)) then
4456 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4457 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4458 edihi=0.25d0*ftors*difi**4
4462 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4464 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4465 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4467 ! write (iout,*) 'edihcnstr',edihcnstr
4470 c----------------------------------------------------------------------------
4471 subroutine etor_d(etors_d,fact2)
4472 C 6/23/01 Compute double torsional energy
4473 implicit real*8 (a-h,o-z)
4474 include 'DIMENSIONS'
4475 include 'DIMENSIONS.ZSCOPT'
4476 include 'COMMON.VAR'
4477 include 'COMMON.GEO'
4478 include 'COMMON.LOCAL'
4479 include 'COMMON.TORSION'
4480 include 'COMMON.INTERACT'
4481 include 'COMMON.DERIV'
4482 include 'COMMON.CHAIN'
4483 include 'COMMON.NAMES'
4484 include 'COMMON.IOUNITS'
4485 include 'COMMON.FFIELD'
4486 include 'COMMON.TORCNSTR'
4488 C Set lprn=.true. for debugging
4492 do i=iphi_start,iphi_end-1
4493 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4495 itori=itortyp(itype(i-2))
4496 itori1=itortyp(itype(i-1))
4497 itori2=itortyp(itype(i))
4502 C Regular cosine and sine terms
4503 do j=1,ntermd_1(itori,itori1,itori2)
4504 v1cij=v1c(1,j,itori,itori1,itori2)
4505 v1sij=v1s(1,j,itori,itori1,itori2)
4506 v2cij=v1c(2,j,itori,itori1,itori2)
4507 v2sij=v1s(2,j,itori,itori1,itori2)
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)
4519 v1cdij = v2c(k,l,itori,itori1,itori2)
4520 v2cdij = v2c(l,k,itori,itori1,itori2)
4521 v1sdij = v2s(k,l,itori,itori1,itori2)
4522 v2sdij = v2s(l,k,itori,itori1,itori2)
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",itau_start,itau_end,nterm_sccor
4571 do i=itau_start,itau_end
4574 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4575 isccori=isccortyp(itype(i-2))
4576 isccori1=isccortyp(itype(i-1))
4578 cccc Added 9 May 2012
4579 cc Tauangle is torsional engle depending on the value of first digit
4580 c(see comment below)
4581 cc Omicron is flat angle depending on the value of first digit
4582 c(see comment below)
4585 do intertyp=1,3 !intertyp
4586 cc Added 09 May 2012 (Adasko)
4587 cc Intertyp means interaction type of backbone mainchain correlation:
4588 c 1 = SC...Ca...Ca...Ca
4589 c 2 = Ca...Ca...Ca...SC
4590 c 3 = SC...Ca...Ca...SCi
4592 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4593 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
4594 & (itype(i-1).eq.21)))
4595 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4596 & .or.(itype(i-2).eq.21)))
4597 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4598 & (itype(i-1).eq.21)))) cycle
4599 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
4600 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
4602 do j=1,nterm_sccor(isccori,isccori1)
4603 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4604 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4605 cosphi=dcos(j*tauangle(intertyp,i))
4606 sinphi=dsin(j*tauangle(intertyp,i))
4607 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4609 esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
4611 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4613 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4614 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
4615 c &gloc_sc(intertyp,i-3,icg)
4617 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4618 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4619 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
4620 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
4621 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
4625 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
4629 c------------------------------------------------------------------------------
4630 subroutine multibody(ecorr)
4631 C This subroutine calculates multi-body contributions to energy following
4632 C the idea of Skolnick et al. If side chains I and J make a contact and
4633 C at the same time side chains I+1 and J+1 make a contact, an extra
4634 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4635 implicit real*8 (a-h,o-z)
4636 include 'DIMENSIONS'
4637 include 'COMMON.IOUNITS'
4638 include 'COMMON.DERIV'
4639 include 'COMMON.INTERACT'
4640 include 'COMMON.CONTACTS'
4641 double precision gx(3),gx1(3)
4644 C Set lprn=.true. for debugging
4648 write (iout,'(a)') 'Contact function values:'
4650 write (iout,'(i2,20(1x,i2,f10.5))')
4651 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4666 num_conti=num_cont(i)
4667 num_conti1=num_cont(i1)
4672 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4673 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4674 cd & ' ishift=',ishift
4675 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4676 C The system gains extra energy.
4677 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4678 endif ! j1==j+-ishift
4687 c------------------------------------------------------------------------------
4688 double precision function esccorr(i,j,k,l,jj,kk)
4689 implicit real*8 (a-h,o-z)
4690 include 'DIMENSIONS'
4691 include 'COMMON.IOUNITS'
4692 include 'COMMON.DERIV'
4693 include 'COMMON.INTERACT'
4694 include 'COMMON.CONTACTS'
4695 double precision gx(3),gx1(3)
4700 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4701 C Calculate the multi-body contribution to energy.
4702 C Calculate multi-body contributions to the gradient.
4703 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4704 cd & k,l,(gacont(m,kk,k),m=1,3)
4706 gx(m) =ekl*gacont(m,jj,i)
4707 gx1(m)=eij*gacont(m,kk,k)
4708 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4709 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4710 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4711 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4715 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4720 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4726 c------------------------------------------------------------------------------
4728 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4729 implicit real*8 (a-h,o-z)
4730 include 'DIMENSIONS'
4731 integer dimen1,dimen2,atom,indx
4732 double precision buffer(dimen1,dimen2)
4733 double precision zapas
4734 common /contacts_hb/ zapas(3,20,maxres,7),
4735 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4736 & num_cont_hb(maxres),jcont_hb(20,maxres)
4737 num_kont=num_cont_hb(atom)
4741 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4744 buffer(i,indx+22)=facont_hb(i,atom)
4745 buffer(i,indx+23)=ees0p(i,atom)
4746 buffer(i,indx+24)=ees0m(i,atom)
4747 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4749 buffer(1,indx+26)=dfloat(num_kont)
4752 c------------------------------------------------------------------------------
4753 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4754 implicit real*8 (a-h,o-z)
4755 include 'DIMENSIONS'
4756 integer dimen1,dimen2,atom,indx
4757 double precision buffer(dimen1,dimen2)
4758 double precision zapas
4759 common /contacts_hb/ zapas(3,20,maxres,7),
4760 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4761 & num_cont_hb(maxres),jcont_hb(20,maxres)
4762 num_kont=buffer(1,indx+26)
4763 num_kont_old=num_cont_hb(atom)
4764 num_cont_hb(atom)=num_kont+num_kont_old
4769 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4772 facont_hb(ii,atom)=buffer(i,indx+22)
4773 ees0p(ii,atom)=buffer(i,indx+23)
4774 ees0m(ii,atom)=buffer(i,indx+24)
4775 jcont_hb(ii,atom)=buffer(i,indx+25)
4779 c------------------------------------------------------------------------------
4781 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4782 C This subroutine calculates multi-body contributions to hydrogen-bonding
4783 implicit real*8 (a-h,o-z)
4784 include 'DIMENSIONS'
4785 include 'DIMENSIONS.ZSCOPT'
4786 include 'COMMON.IOUNITS'
4788 include 'COMMON.INFO'
4790 include 'COMMON.FFIELD'
4791 include 'COMMON.DERIV'
4792 include 'COMMON.INTERACT'
4793 include 'COMMON.CONTACTS'
4795 parameter (max_cont=maxconts)
4796 parameter (max_dim=2*(8*3+2))
4797 parameter (msglen1=max_cont*max_dim*4)
4798 parameter (msglen2=2*msglen1)
4799 integer source,CorrelType,CorrelID,Error
4800 double precision buffer(max_cont,max_dim)
4802 double precision gx(3),gx1(3)
4805 C Set lprn=.true. for debugging
4810 if (fgProcs.le.1) goto 30
4812 write (iout,'(a)') 'Contact function values:'
4814 write (iout,'(2i3,50(1x,i2,f5.2))')
4815 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4816 & j=1,num_cont_hb(i))
4819 C Caution! Following code assumes that electrostatic interactions concerning
4820 C a given atom are split among at most two processors!
4830 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4833 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4834 if (MyRank.gt.0) then
4835 C Send correlation contributions to the preceding processor
4837 nn=num_cont_hb(iatel_s)
4838 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4839 cd write (iout,*) 'The BUFFER array:'
4841 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4843 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4845 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4846 C Clear the contacts of the atom passed to the neighboring processor
4847 nn=num_cont_hb(iatel_s+1)
4849 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4851 num_cont_hb(iatel_s)=0
4853 cd write (iout,*) 'Processor ',MyID,MyRank,
4854 cd & ' is sending correlation contribution to processor',MyID-1,
4855 cd & ' msglen=',msglen
4856 cd write (*,*) 'Processor ',MyID,MyRank,
4857 cd & ' is sending correlation contribution to processor',MyID-1,
4858 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4859 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4860 cd write (iout,*) 'Processor ',MyID,
4861 cd & ' has sent correlation contribution to processor',MyID-1,
4862 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4863 cd write (*,*) 'Processor ',MyID,
4864 cd & ' has sent correlation contribution to processor',MyID-1,
4865 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4867 endif ! (MyRank.gt.0)
4871 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4872 if (MyRank.lt.fgProcs-1) then
4873 C Receive correlation contributions from the next processor
4875 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4876 cd write (iout,*) 'Processor',MyID,
4877 cd & ' is receiving correlation contribution from processor',MyID+1,
4878 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4879 cd write (*,*) 'Processor',MyID,
4880 cd & ' is receiving correlation contribution from processor',MyID+1,
4881 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4883 do while (nbytes.le.0)
4884 call mp_probe(MyID+1,CorrelType,nbytes)
4886 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4887 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4888 cd write (iout,*) 'Processor',MyID,
4889 cd & ' has received correlation contribution from processor',MyID+1,
4890 cd & ' msglen=',msglen,' nbytes=',nbytes
4891 cd write (iout,*) 'The received BUFFER array:'
4893 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4895 if (msglen.eq.msglen1) then
4896 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4897 else if (msglen.eq.msglen2) then
4898 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4899 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4902 & 'ERROR!!!! message length changed while processing correlations.'
4904 & 'ERROR!!!! message length changed while processing correlations.'
4905 call mp_stopall(Error)
4906 endif ! msglen.eq.msglen1
4907 endif ! MyRank.lt.fgProcs-1
4914 write (iout,'(a)') 'Contact function values:'
4916 write (iout,'(2i3,50(1x,i2,f5.2))')
4917 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4918 & j=1,num_cont_hb(i))
4922 C Remove the loop below after debugging !!!
4929 C Calculate the local-electrostatic correlation terms
4930 do i=iatel_s,iatel_e+1
4932 num_conti=num_cont_hb(i)
4933 num_conti1=num_cont_hb(i+1)
4938 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4939 c & ' jj=',jj,' kk=',kk
4940 if (j1.eq.j+1 .or. j1.eq.j-1) then
4941 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4942 C The system gains extra energy.
4943 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4945 else if (j1.eq.j) then
4946 C Contacts I-J and I-(J+1) occur simultaneously.
4947 C The system loses extra energy.
4948 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4953 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4954 c & ' jj=',jj,' kk=',kk
4956 C Contacts I-J and (I+1)-J occur simultaneously.
4957 C The system loses extra energy.
4958 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4965 c------------------------------------------------------------------------------
4966 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4968 C This subroutine calculates multi-body contributions to hydrogen-bonding
4969 implicit real*8 (a-h,o-z)
4970 include 'DIMENSIONS'
4971 include 'DIMENSIONS.ZSCOPT'
4972 include 'COMMON.IOUNITS'
4974 include 'COMMON.INFO'
4976 include 'COMMON.FFIELD'
4977 include 'COMMON.DERIV'
4978 include 'COMMON.INTERACT'
4979 include 'COMMON.CONTACTS'
4981 parameter (max_cont=maxconts)
4982 parameter (max_dim=2*(8*3+2))
4983 parameter (msglen1=max_cont*max_dim*4)
4984 parameter (msglen2=2*msglen1)
4985 integer source,CorrelType,CorrelID,Error
4986 double precision buffer(max_cont,max_dim)
4988 double precision gx(3),gx1(3)
4991 C Set lprn=.true. for debugging
4997 if (fgProcs.le.1) goto 30
4999 write (iout,'(a)') 'Contact function values:'
5001 write (iout,'(2i3,50(1x,i2,f5.2))')
5002 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5003 & j=1,num_cont_hb(i))
5006 C Caution! Following code assumes that electrostatic interactions concerning
5007 C a given atom are split among at most two processors!
5017 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5020 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5021 if (MyRank.gt.0) then
5022 C Send correlation contributions to the preceding processor
5024 nn=num_cont_hb(iatel_s)
5025 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5026 cd write (iout,*) 'The BUFFER array:'
5028 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5030 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5032 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5033 C Clear the contacts of the atom passed to the neighboring processor
5034 nn=num_cont_hb(iatel_s+1)
5036 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5038 num_cont_hb(iatel_s)=0
5040 cd write (iout,*) 'Processor ',MyID,MyRank,
5041 cd & ' is sending correlation contribution to processor',MyID-1,
5042 cd & ' msglen=',msglen
5043 cd write (*,*) 'Processor ',MyID,MyRank,
5044 cd & ' is sending correlation contribution to processor',MyID-1,
5045 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5046 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5047 cd write (iout,*) 'Processor ',MyID,
5048 cd & ' has sent correlation contribution to processor',MyID-1,
5049 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5050 cd write (*,*) 'Processor ',MyID,
5051 cd & ' has sent correlation contribution to processor',MyID-1,
5052 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5054 endif ! (MyRank.gt.0)
5058 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5059 if (MyRank.lt.fgProcs-1) then
5060 C Receive correlation contributions from the next processor
5062 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5063 cd write (iout,*) 'Processor',MyID,
5064 cd & ' is receiving correlation contribution from processor',MyID+1,
5065 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5066 cd write (*,*) 'Processor',MyID,
5067 cd & ' is receiving correlation contribution from processor',MyID+1,
5068 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5070 do while (nbytes.le.0)
5071 call mp_probe(MyID+1,CorrelType,nbytes)
5073 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5074 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5075 cd write (iout,*) 'Processor',MyID,
5076 cd & ' has received correlation contribution from processor',MyID+1,
5077 cd & ' msglen=',msglen,' nbytes=',nbytes
5078 cd write (iout,*) 'The received BUFFER array:'
5080 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5082 if (msglen.eq.msglen1) then
5083 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5084 else if (msglen.eq.msglen2) then
5085 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5086 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5089 & 'ERROR!!!! message length changed while processing correlations.'
5091 & 'ERROR!!!! message length changed while processing correlations.'
5092 call mp_stopall(Error)
5093 endif ! msglen.eq.msglen1
5094 endif ! MyRank.lt.fgProcs-1
5101 write (iout,'(a)') 'Contact function values:'
5103 write (iout,'(2i3,50(1x,i2,f5.2))')
5104 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5105 & j=1,num_cont_hb(i))
5111 C Remove the loop below after debugging !!!
5118 C Calculate the dipole-dipole interaction energies
5119 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5120 do i=iatel_s,iatel_e+1
5121 num_conti=num_cont_hb(i)
5128 C Calculate the local-electrostatic correlation terms
5129 do i=iatel_s,iatel_e+1
5131 num_conti=num_cont_hb(i)
5132 num_conti1=num_cont_hb(i+1)
5137 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5138 c & ' jj=',jj,' kk=',kk
5139 if (j1.eq.j+1 .or. j1.eq.j-1) then
5140 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5141 C The system gains extra energy.
5143 sqd1=dsqrt(d_cont(jj,i))
5144 sqd2=dsqrt(d_cont(kk,i1))
5145 sred_geom = sqd1*sqd2
5146 IF (sred_geom.lt.cutoff_corr) THEN
5147 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5149 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5150 c & ' jj=',jj,' kk=',kk
5151 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5152 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5154 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5155 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5158 cd write (iout,*) 'sred_geom=',sred_geom,
5159 cd & ' ekont=',ekont,' fprim=',fprimcont
5160 call calc_eello(i,j,i+1,j1,jj,kk)
5161 if (wcorr4.gt.0.0d0)
5162 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5163 if (wcorr5.gt.0.0d0)
5164 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5165 c print *,"wcorr5",ecorr5
5166 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5167 cd write(2,*)'ijkl',i,j,i+1,j1
5168 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5169 & .or. wturn6.eq.0.0d0))then
5170 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5171 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5172 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5173 cd & 'ecorr6=',ecorr6
5174 cd write (iout,'(4e15.5)') sred_geom,
5175 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5176 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5177 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5178 else if (wturn6.gt.0.0d0
5179 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5180 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5181 eturn6=eturn6+eello_turn6(i,jj,kk)
5182 cd write (2,*) 'multibody_eello:eturn6',eturn6
5186 else if (j1.eq.j) then
5187 C Contacts I-J and I-(J+1) occur simultaneously.
5188 C The system loses extra energy.
5189 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5194 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5195 c & ' jj=',jj,' kk=',kk
5197 C Contacts I-J and (I+1)-J occur simultaneously.
5198 C The system loses extra energy.
5199 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5206 c------------------------------------------------------------------------------
5207 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5208 implicit real*8 (a-h,o-z)
5209 include 'DIMENSIONS'
5210 include 'COMMON.IOUNITS'
5211 include 'COMMON.DERIV'
5212 include 'COMMON.INTERACT'
5213 include 'COMMON.CONTACTS'
5214 double precision gx(3),gx1(3)
5224 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5225 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5226 C Following 4 lines for diagnostics.
5231 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5233 c write (iout,*)'Contacts have occurred for peptide groups',
5234 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5235 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5236 C Calculate the multi-body contribution to energy.
5237 ecorr=ecorr+ekont*ees
5239 C Calculate multi-body contributions to the gradient.
5241 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5242 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5243 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5244 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5245 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5246 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5247 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5248 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5249 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5250 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5251 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5252 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5253 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5254 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5258 gradcorr(ll,m)=gradcorr(ll,m)+
5259 & ees*ekl*gacont_hbr(ll,jj,i)-
5260 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5261 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5266 gradcorr(ll,m)=gradcorr(ll,m)+
5267 & ees*eij*gacont_hbr(ll,kk,k)-
5268 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5269 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5276 C---------------------------------------------------------------------------
5277 subroutine dipole(i,j,jj)
5278 implicit real*8 (a-h,o-z)
5279 include 'DIMENSIONS'
5280 include 'DIMENSIONS.ZSCOPT'
5281 include 'COMMON.IOUNITS'
5282 include 'COMMON.CHAIN'
5283 include 'COMMON.FFIELD'
5284 include 'COMMON.DERIV'
5285 include 'COMMON.INTERACT'
5286 include 'COMMON.CONTACTS'
5287 include 'COMMON.TORSION'
5288 include 'COMMON.VAR'
5289 include 'COMMON.GEO'
5290 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5292 iti1 = itortyp(itype(i+1))
5293 if (j.lt.nres-1) then
5294 itj1 = itortyp(itype(j+1))
5299 dipi(iii,1)=Ub2(iii,i)
5300 dipderi(iii)=Ub2der(iii,i)
5301 dipi(iii,2)=b1(iii,iti1)
5302 dipj(iii,1)=Ub2(iii,j)
5303 dipderj(iii)=Ub2der(iii,j)
5304 dipj(iii,2)=b1(iii,itj1)
5308 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5311 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5314 if (.not.calc_grad) return
5319 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5323 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5328 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5329 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5331 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5333 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5335 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5339 C---------------------------------------------------------------------------
5340 subroutine calc_eello(i,j,k,l,jj,kk)
5342 C This subroutine computes matrices and vectors needed to calculate
5343 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5345 implicit real*8 (a-h,o-z)
5346 include 'DIMENSIONS'
5347 include 'DIMENSIONS.ZSCOPT'
5348 include 'COMMON.IOUNITS'
5349 include 'COMMON.CHAIN'
5350 include 'COMMON.DERIV'
5351 include 'COMMON.INTERACT'
5352 include 'COMMON.CONTACTS'
5353 include 'COMMON.TORSION'
5354 include 'COMMON.VAR'
5355 include 'COMMON.GEO'
5356 include 'COMMON.FFIELD'
5357 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5358 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5361 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5362 cd & ' jj=',jj,' kk=',kk
5363 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5366 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5367 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5370 call transpose2(aa1(1,1),aa1t(1,1))
5371 call transpose2(aa2(1,1),aa2t(1,1))
5374 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5375 & aa1tder(1,1,lll,kkk))
5376 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5377 & aa2tder(1,1,lll,kkk))
5381 C parallel orientation of the two CA-CA-CA frames.
5383 iti=itortyp(itype(i))
5387 itk1=itortyp(itype(k+1))
5388 itj=itortyp(itype(j))
5389 if (l.lt.nres-1) then
5390 itl1=itortyp(itype(l+1))
5394 C A1 kernel(j+1) A2T
5396 cd write (iout,'(3f10.5,5x,3f10.5)')
5397 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5399 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5400 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5401 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5402 C Following matrices are needed only for 6-th order cumulants
5403 IF (wcorr6.gt.0.0d0) THEN
5404 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5405 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5406 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5407 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5408 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5409 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5410 & ADtEAderx(1,1,1,1,1,1))
5412 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5413 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5414 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5415 & ADtEA1derx(1,1,1,1,1,1))
5417 C End 6-th order cumulants
5420 cd write (2,*) 'In calc_eello6'
5422 cd write (2,*) 'iii=',iii
5424 cd write (2,*) 'kkk=',kkk
5426 cd write (2,'(3(2f10.5),5x)')
5427 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5432 call transpose2(EUgder(1,1,k),auxmat(1,1))
5433 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5434 call transpose2(EUg(1,1,k),auxmat(1,1))
5435 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5436 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5440 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5441 & EAEAderx(1,1,lll,kkk,iii,1))
5445 C A1T kernel(i+1) A2
5446 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5447 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5448 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5449 C Following matrices are needed only for 6-th order cumulants
5450 IF (wcorr6.gt.0.0d0) THEN
5451 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5452 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5453 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5454 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5455 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5456 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5457 & ADtEAderx(1,1,1,1,1,2))
5458 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5459 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5460 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5461 & ADtEA1derx(1,1,1,1,1,2))
5463 C End 6-th order cumulants
5464 call transpose2(EUgder(1,1,l),auxmat(1,1))
5465 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5466 call transpose2(EUg(1,1,l),auxmat(1,1))
5467 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5468 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5472 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5473 & EAEAderx(1,1,lll,kkk,iii,2))
5478 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5479 C They are needed only when the fifth- or the sixth-order cumulants are
5481 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5482 call transpose2(AEA(1,1,1),auxmat(1,1))
5483 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5484 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5485 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5486 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5487 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5488 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5489 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5490 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5491 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5492 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5493 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5494 call transpose2(AEA(1,1,2),auxmat(1,1))
5495 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5496 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5497 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5498 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5499 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5500 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5501 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5502 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5503 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5504 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5505 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5506 C Calculate the Cartesian derivatives of the vectors.
5510 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5511 call matvec2(auxmat(1,1),b1(1,iti),
5512 & AEAb1derx(1,lll,kkk,iii,1,1))
5513 call matvec2(auxmat(1,1),Ub2(1,i),
5514 & AEAb2derx(1,lll,kkk,iii,1,1))
5515 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5516 & AEAb1derx(1,lll,kkk,iii,2,1))
5517 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5518 & AEAb2derx(1,lll,kkk,iii,2,1))
5519 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5520 call matvec2(auxmat(1,1),b1(1,itj),
5521 & AEAb1derx(1,lll,kkk,iii,1,2))
5522 call matvec2(auxmat(1,1),Ub2(1,j),
5523 & AEAb2derx(1,lll,kkk,iii,1,2))
5524 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5525 & AEAb1derx(1,lll,kkk,iii,2,2))
5526 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5527 & AEAb2derx(1,lll,kkk,iii,2,2))
5534 C Antiparallel orientation of the two CA-CA-CA frames.
5536 iti=itortyp(itype(i))
5540 itk1=itortyp(itype(k+1))
5541 itl=itortyp(itype(l))
5542 itj=itortyp(itype(j))
5543 if (j.lt.nres-1) then
5544 itj1=itortyp(itype(j+1))
5548 C A2 kernel(j-1)T A1T
5549 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5550 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5551 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5552 C Following matrices are needed only for 6-th order cumulants
5553 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5554 & j.eq.i+4 .and. l.eq.i+3)) THEN
5555 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5556 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5557 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5558 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5559 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5560 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5561 & ADtEAderx(1,1,1,1,1,1))
5562 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5563 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5564 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5565 & ADtEA1derx(1,1,1,1,1,1))
5567 C End 6-th order cumulants
5568 call transpose2(EUgder(1,1,k),auxmat(1,1))
5569 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5570 call transpose2(EUg(1,1,k),auxmat(1,1))
5571 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5572 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5576 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5577 & EAEAderx(1,1,lll,kkk,iii,1))
5581 C A2T kernel(i+1)T A1
5582 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5583 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5584 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5585 C Following matrices are needed only for 6-th order cumulants
5586 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5587 & j.eq.i+4 .and. l.eq.i+3)) THEN
5588 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5589 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5590 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5591 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5592 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5593 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5594 & ADtEAderx(1,1,1,1,1,2))
5595 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5596 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5597 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5598 & ADtEA1derx(1,1,1,1,1,2))
5600 C End 6-th order cumulants
5601 call transpose2(EUgder(1,1,j),auxmat(1,1))
5602 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5603 call transpose2(EUg(1,1,j),auxmat(1,1))
5604 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5605 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5609 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5610 & EAEAderx(1,1,lll,kkk,iii,2))
5615 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5616 C They are needed only when the fifth- or the sixth-order cumulants are
5618 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5619 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5620 call transpose2(AEA(1,1,1),auxmat(1,1))
5621 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5622 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5623 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5624 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5625 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5626 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5627 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5628 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5629 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5630 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5631 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5632 call transpose2(AEA(1,1,2),auxmat(1,1))
5633 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5634 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5635 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5636 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5637 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5638 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5639 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5640 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5641 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5642 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5643 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5644 C Calculate the Cartesian derivatives of the vectors.
5648 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5649 call matvec2(auxmat(1,1),b1(1,iti),
5650 & AEAb1derx(1,lll,kkk,iii,1,1))
5651 call matvec2(auxmat(1,1),Ub2(1,i),
5652 & AEAb2derx(1,lll,kkk,iii,1,1))
5653 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5654 & AEAb1derx(1,lll,kkk,iii,2,1))
5655 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5656 & AEAb2derx(1,lll,kkk,iii,2,1))
5657 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5658 call matvec2(auxmat(1,1),b1(1,itl),
5659 & AEAb1derx(1,lll,kkk,iii,1,2))
5660 call matvec2(auxmat(1,1),Ub2(1,l),
5661 & AEAb2derx(1,lll,kkk,iii,1,2))
5662 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5663 & AEAb1derx(1,lll,kkk,iii,2,2))
5664 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5665 & AEAb2derx(1,lll,kkk,iii,2,2))
5674 C---------------------------------------------------------------------------
5675 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5676 & KK,KKderg,AKA,AKAderg,AKAderx)
5680 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5681 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5682 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5687 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5689 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5692 cd if (lprn) write (2,*) 'In kernel'
5694 cd if (lprn) write (2,*) 'kkk=',kkk
5696 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5697 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5699 cd write (2,*) 'lll=',lll
5700 cd write (2,*) 'iii=1'
5702 cd write (2,'(3(2f10.5),5x)')
5703 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5706 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5707 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5709 cd write (2,*) 'lll=',lll
5710 cd write (2,*) 'iii=2'
5712 cd write (2,'(3(2f10.5),5x)')
5713 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5720 C---------------------------------------------------------------------------
5721 double precision function eello4(i,j,k,l,jj,kk)
5722 implicit real*8 (a-h,o-z)
5723 include 'DIMENSIONS'
5724 include 'DIMENSIONS.ZSCOPT'
5725 include 'COMMON.IOUNITS'
5726 include 'COMMON.CHAIN'
5727 include 'COMMON.DERIV'
5728 include 'COMMON.INTERACT'
5729 include 'COMMON.CONTACTS'
5730 include 'COMMON.TORSION'
5731 include 'COMMON.VAR'
5732 include 'COMMON.GEO'
5733 double precision pizda(2,2),ggg1(3),ggg2(3)
5734 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5738 cd print *,'eello4:',i,j,k,l,jj,kk
5739 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5740 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5741 cold eij=facont_hb(jj,i)
5742 cold ekl=facont_hb(kk,k)
5744 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5746 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5747 gcorr_loc(k-1)=gcorr_loc(k-1)
5748 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5750 gcorr_loc(l-1)=gcorr_loc(l-1)
5751 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5753 gcorr_loc(j-1)=gcorr_loc(j-1)
5754 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5759 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5760 & -EAEAderx(2,2,lll,kkk,iii,1)
5761 cd derx(lll,kkk,iii)=0.0d0
5765 cd gcorr_loc(l-1)=0.0d0
5766 cd gcorr_loc(j-1)=0.0d0
5767 cd gcorr_loc(k-1)=0.0d0
5769 cd write (iout,*)'Contacts have occurred for peptide groups',
5770 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5771 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5772 if (j.lt.nres-1) then
5779 if (l.lt.nres-1) then
5787 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5788 ggg1(ll)=eel4*g_contij(ll,1)
5789 ggg2(ll)=eel4*g_contij(ll,2)
5790 ghalf=0.5d0*ggg1(ll)
5792 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5793 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5794 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5795 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5796 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5797 ghalf=0.5d0*ggg2(ll)
5799 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5800 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5801 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5802 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5807 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5808 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5813 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5814 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5820 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5825 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5829 cd write (2,*) iii,gcorr_loc(iii)
5833 cd write (2,*) 'ekont',ekont
5834 cd write (iout,*) 'eello4',ekont*eel4
5837 C---------------------------------------------------------------------------
5838 double precision function eello5(i,j,k,l,jj,kk)
5839 implicit real*8 (a-h,o-z)
5840 include 'DIMENSIONS'
5841 include 'DIMENSIONS.ZSCOPT'
5842 include 'COMMON.IOUNITS'
5843 include 'COMMON.CHAIN'
5844 include 'COMMON.DERIV'
5845 include 'COMMON.INTERACT'
5846 include 'COMMON.CONTACTS'
5847 include 'COMMON.TORSION'
5848 include 'COMMON.VAR'
5849 include 'COMMON.GEO'
5850 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5851 double precision ggg1(3),ggg2(3)
5852 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5857 C /l\ / \ \ / \ / \ / C
5858 C / \ / \ \ / \ / \ / C
5859 C j| o |l1 | o | o| o | | o |o C
5860 C \ |/k\| |/ \| / |/ \| |/ \| C
5861 C \i/ \ / \ / / \ / \ C
5863 C (I) (II) (III) (IV) C
5865 C eello5_1 eello5_2 eello5_3 eello5_4 C
5867 C Antiparallel chains C
5870 C /j\ / \ \ / \ / \ / C
5871 C / \ / \ \ / \ / \ / C
5872 C j1| o |l | o | o| o | | o |o C
5873 C \ |/k\| |/ \| / |/ \| |/ \| C
5874 C \i/ \ / \ / / \ / \ C
5876 C (I) (II) (III) (IV) C
5878 C eello5_1 eello5_2 eello5_3 eello5_4 C
5880 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5882 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5883 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5888 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5890 itk=itortyp(itype(k))
5891 itl=itortyp(itype(l))
5892 itj=itortyp(itype(j))
5897 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5898 cd & eel5_3_num,eel5_4_num)
5902 derx(lll,kkk,iii)=0.0d0
5906 cd eij=facont_hb(jj,i)
5907 cd ekl=facont_hb(kk,k)
5909 cd write (iout,*)'Contacts have occurred for peptide groups',
5910 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5912 C Contribution from the graph I.
5913 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5914 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5915 call transpose2(EUg(1,1,k),auxmat(1,1))
5916 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5917 vv(1)=pizda(1,1)-pizda(2,2)
5918 vv(2)=pizda(1,2)+pizda(2,1)
5919 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5920 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5922 C Explicit gradient in virtual-dihedral angles.
5923 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5924 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5925 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5926 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5927 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5928 vv(1)=pizda(1,1)-pizda(2,2)
5929 vv(2)=pizda(1,2)+pizda(2,1)
5930 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5931 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5932 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5933 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5934 vv(1)=pizda(1,1)-pizda(2,2)
5935 vv(2)=pizda(1,2)+pizda(2,1)
5937 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5938 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5939 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5941 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5942 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5943 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5945 C Cartesian gradient
5949 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5951 vv(1)=pizda(1,1)-pizda(2,2)
5952 vv(2)=pizda(1,2)+pizda(2,1)
5953 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5954 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5955 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5962 C Contribution from graph II
5963 call transpose2(EE(1,1,itk),auxmat(1,1))
5964 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5965 vv(1)=pizda(1,1)+pizda(2,2)
5966 vv(2)=pizda(2,1)-pizda(1,2)
5967 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5968 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5970 C Explicit gradient in virtual-dihedral angles.
5971 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5972 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5973 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5974 vv(1)=pizda(1,1)+pizda(2,2)
5975 vv(2)=pizda(2,1)-pizda(1,2)
5977 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5978 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5979 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5981 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5982 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5983 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5985 C Cartesian gradient
5989 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5991 vv(1)=pizda(1,1)+pizda(2,2)
5992 vv(2)=pizda(2,1)-pizda(1,2)
5993 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5994 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5995 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6004 C Parallel orientation
6005 C Contribution from graph III
6006 call transpose2(EUg(1,1,l),auxmat(1,1))
6007 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6008 vv(1)=pizda(1,1)-pizda(2,2)
6009 vv(2)=pizda(1,2)+pizda(2,1)
6010 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6011 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6013 C Explicit gradient in virtual-dihedral angles.
6014 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6015 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6016 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6017 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6018 vv(1)=pizda(1,1)-pizda(2,2)
6019 vv(2)=pizda(1,2)+pizda(2,1)
6020 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6021 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6022 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6023 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6024 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6025 vv(1)=pizda(1,1)-pizda(2,2)
6026 vv(2)=pizda(1,2)+pizda(2,1)
6027 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6028 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6029 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6030 C Cartesian gradient
6034 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6036 vv(1)=pizda(1,1)-pizda(2,2)
6037 vv(2)=pizda(1,2)+pizda(2,1)
6038 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6039 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6040 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6046 C Contribution from graph IV
6048 call transpose2(EE(1,1,itl),auxmat(1,1))
6049 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6050 vv(1)=pizda(1,1)+pizda(2,2)
6051 vv(2)=pizda(2,1)-pizda(1,2)
6052 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6053 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6055 C Explicit gradient in virtual-dihedral angles.
6056 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6057 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6058 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6059 vv(1)=pizda(1,1)+pizda(2,2)
6060 vv(2)=pizda(2,1)-pizda(1,2)
6061 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6062 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6063 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6064 C Cartesian gradient
6068 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6070 vv(1)=pizda(1,1)+pizda(2,2)
6071 vv(2)=pizda(2,1)-pizda(1,2)
6072 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6073 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6074 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6080 C Antiparallel orientation
6081 C Contribution from graph III
6083 call transpose2(EUg(1,1,j),auxmat(1,1))
6084 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6085 vv(1)=pizda(1,1)-pizda(2,2)
6086 vv(2)=pizda(1,2)+pizda(2,1)
6087 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6088 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6090 C Explicit gradient in virtual-dihedral angles.
6091 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6092 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6093 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6094 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6095 vv(1)=pizda(1,1)-pizda(2,2)
6096 vv(2)=pizda(1,2)+pizda(2,1)
6097 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6098 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6099 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6100 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6101 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6102 vv(1)=pizda(1,1)-pizda(2,2)
6103 vv(2)=pizda(1,2)+pizda(2,1)
6104 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6105 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6106 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6107 C Cartesian gradient
6111 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6113 vv(1)=pizda(1,1)-pizda(2,2)
6114 vv(2)=pizda(1,2)+pizda(2,1)
6115 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6116 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6117 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6123 C Contribution from graph IV
6125 call transpose2(EE(1,1,itj),auxmat(1,1))
6126 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6127 vv(1)=pizda(1,1)+pizda(2,2)
6128 vv(2)=pizda(2,1)-pizda(1,2)
6129 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6130 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6132 C Explicit gradient in virtual-dihedral angles.
6133 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6134 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6135 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6136 vv(1)=pizda(1,1)+pizda(2,2)
6137 vv(2)=pizda(2,1)-pizda(1,2)
6138 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6139 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6140 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6141 C Cartesian gradient
6145 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6147 vv(1)=pizda(1,1)+pizda(2,2)
6148 vv(2)=pizda(2,1)-pizda(1,2)
6149 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6150 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6151 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6158 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6159 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6160 cd write (2,*) 'ijkl',i,j,k,l
6161 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6162 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6164 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6165 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6166 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6167 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6169 if (j.lt.nres-1) then
6176 if (l.lt.nres-1) then
6186 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6188 ggg1(ll)=eel5*g_contij(ll,1)
6189 ggg2(ll)=eel5*g_contij(ll,2)
6190 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6191 ghalf=0.5d0*ggg1(ll)
6193 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6194 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6195 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6196 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6197 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6198 ghalf=0.5d0*ggg2(ll)
6200 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6201 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6202 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6203 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6208 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6209 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6214 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6215 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6221 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6226 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6230 cd write (2,*) iii,g_corr5_loc(iii)
6234 cd write (2,*) 'ekont',ekont
6235 cd write (iout,*) 'eello5',ekont*eel5
6238 c--------------------------------------------------------------------------
6239 double precision function eello6(i,j,k,l,jj,kk)
6240 implicit real*8 (a-h,o-z)
6241 include 'DIMENSIONS'
6242 include 'DIMENSIONS.ZSCOPT'
6243 include 'COMMON.IOUNITS'
6244 include 'COMMON.CHAIN'
6245 include 'COMMON.DERIV'
6246 include 'COMMON.INTERACT'
6247 include 'COMMON.CONTACTS'
6248 include 'COMMON.TORSION'
6249 include 'COMMON.VAR'
6250 include 'COMMON.GEO'
6251 include 'COMMON.FFIELD'
6252 double precision ggg1(3),ggg2(3)
6253 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6258 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6266 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6267 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6271 derx(lll,kkk,iii)=0.0d0
6275 cd eij=facont_hb(jj,i)
6276 cd ekl=facont_hb(kk,k)
6282 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6283 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6284 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6285 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6286 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6287 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6289 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6290 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6291 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6292 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6293 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6294 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6298 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6300 C If turn contributions are considered, they will be handled separately.
6301 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6302 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6303 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6304 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6305 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6306 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6307 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6310 if (j.lt.nres-1) then
6317 if (l.lt.nres-1) then
6325 ggg1(ll)=eel6*g_contij(ll,1)
6326 ggg2(ll)=eel6*g_contij(ll,2)
6327 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6328 ghalf=0.5d0*ggg1(ll)
6330 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6331 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6332 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6333 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6334 ghalf=0.5d0*ggg2(ll)
6335 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6337 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6338 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6339 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6340 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6345 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6346 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6351 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6352 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6358 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6363 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6367 cd write (2,*) iii,g_corr6_loc(iii)
6371 cd write (2,*) 'ekont',ekont
6372 cd write (iout,*) 'eello6',ekont*eel6
6375 c--------------------------------------------------------------------------
6376 double precision function eello6_graph1(i,j,k,l,imat,swap)
6377 implicit real*8 (a-h,o-z)
6378 include 'DIMENSIONS'
6379 include 'DIMENSIONS.ZSCOPT'
6380 include 'COMMON.IOUNITS'
6381 include 'COMMON.CHAIN'
6382 include 'COMMON.DERIV'
6383 include 'COMMON.INTERACT'
6384 include 'COMMON.CONTACTS'
6385 include 'COMMON.TORSION'
6386 include 'COMMON.VAR'
6387 include 'COMMON.GEO'
6388 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6392 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6394 C Parallel Antiparallel C
6400 C \ j|/k\| / \ |/k\|l / C
6405 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6406 itk=itortyp(itype(k))
6407 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6408 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6409 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6410 call transpose2(EUgC(1,1,k),auxmat(1,1))
6411 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6412 vv1(1)=pizda1(1,1)-pizda1(2,2)
6413 vv1(2)=pizda1(1,2)+pizda1(2,1)
6414 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6415 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6416 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6417 s5=scalar2(vv(1),Dtobr2(1,i))
6418 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6419 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6420 if (.not. calc_grad) return
6421 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6422 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6423 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6424 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6425 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6426 & +scalar2(vv(1),Dtobr2der(1,i)))
6427 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6428 vv1(1)=pizda1(1,1)-pizda1(2,2)
6429 vv1(2)=pizda1(1,2)+pizda1(2,1)
6430 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6431 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6433 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6434 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6435 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6436 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6437 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6439 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6440 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6441 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6442 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6443 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6445 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6446 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6447 vv1(1)=pizda1(1,1)-pizda1(2,2)
6448 vv1(2)=pizda1(1,2)+pizda1(2,1)
6449 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6450 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6451 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6452 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6461 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6462 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6463 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6464 call transpose2(EUgC(1,1,k),auxmat(1,1))
6465 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6467 vv1(1)=pizda1(1,1)-pizda1(2,2)
6468 vv1(2)=pizda1(1,2)+pizda1(2,1)
6469 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6470 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6471 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6472 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6473 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6474 s5=scalar2(vv(1),Dtobr2(1,i))
6475 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6481 c----------------------------------------------------------------------------
6482 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6483 implicit real*8 (a-h,o-z)
6484 include 'DIMENSIONS'
6485 include 'DIMENSIONS.ZSCOPT'
6486 include 'COMMON.IOUNITS'
6487 include 'COMMON.CHAIN'
6488 include 'COMMON.DERIV'
6489 include 'COMMON.INTERACT'
6490 include 'COMMON.CONTACTS'
6491 include 'COMMON.TORSION'
6492 include 'COMMON.VAR'
6493 include 'COMMON.GEO'
6495 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6496 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6499 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6501 C Parallel Antiparallel C
6507 C \ j|/k\| \ |/k\|l C
6512 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6513 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6514 C AL 7/4/01 s1 would occur in the sixth-order moment,
6515 C but not in a cluster cumulant
6517 s1=dip(1,jj,i)*dip(1,kk,k)
6519 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6520 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6521 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6522 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6523 call transpose2(EUg(1,1,k),auxmat(1,1))
6524 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6525 vv(1)=pizda(1,1)-pizda(2,2)
6526 vv(2)=pizda(1,2)+pizda(2,1)
6527 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6528 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6530 eello6_graph2=-(s1+s2+s3+s4)
6532 eello6_graph2=-(s2+s3+s4)
6535 if (.not. calc_grad) return
6536 C Derivatives in gamma(i-1)
6539 s1=dipderg(1,jj,i)*dip(1,kk,k)
6541 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6542 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6543 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6544 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6546 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6548 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6550 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6552 C Derivatives in gamma(k-1)
6554 s1=dip(1,jj,i)*dipderg(1,kk,k)
6556 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6557 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6558 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6559 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6560 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6561 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6562 vv(1)=pizda(1,1)-pizda(2,2)
6563 vv(2)=pizda(1,2)+pizda(2,1)
6564 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6566 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6568 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6570 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6571 C Derivatives in gamma(j-1) or gamma(l-1)
6574 s1=dipderg(3,jj,i)*dip(1,kk,k)
6576 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6577 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6578 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6579 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6580 vv(1)=pizda(1,1)-pizda(2,2)
6581 vv(2)=pizda(1,2)+pizda(2,1)
6582 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6585 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6587 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6590 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6591 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6593 C Derivatives in gamma(l-1) or gamma(j-1)
6596 s1=dip(1,jj,i)*dipderg(3,kk,k)
6598 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6599 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6600 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6601 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6602 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6603 vv(1)=pizda(1,1)-pizda(2,2)
6604 vv(2)=pizda(1,2)+pizda(2,1)
6605 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6608 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6610 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6613 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6614 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6616 C Cartesian derivatives.
6618 write (2,*) 'In eello6_graph2'
6620 write (2,*) 'iii=',iii
6622 write (2,*) 'kkk=',kkk
6624 write (2,'(3(2f10.5),5x)')
6625 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6635 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6637 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6640 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6642 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6643 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6645 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6646 call transpose2(EUg(1,1,k),auxmat(1,1))
6647 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6649 vv(1)=pizda(1,1)-pizda(2,2)
6650 vv(2)=pizda(1,2)+pizda(2,1)
6651 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6652 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6654 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6656 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6659 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6661 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6668 c----------------------------------------------------------------------------
6669 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6670 implicit real*8 (a-h,o-z)
6671 include 'DIMENSIONS'
6672 include 'DIMENSIONS.ZSCOPT'
6673 include 'COMMON.IOUNITS'
6674 include 'COMMON.CHAIN'
6675 include 'COMMON.DERIV'
6676 include 'COMMON.INTERACT'
6677 include 'COMMON.CONTACTS'
6678 include 'COMMON.TORSION'
6679 include 'COMMON.VAR'
6680 include 'COMMON.GEO'
6681 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6683 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6685 C Parallel Antiparallel C
6691 C j|/k\| / |/k\|l / C
6696 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6698 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6699 C energy moment and not to the cluster cumulant.
6700 iti=itortyp(itype(i))
6701 if (j.lt.nres-1) then
6702 itj1=itortyp(itype(j+1))
6706 itk=itortyp(itype(k))
6707 itk1=itortyp(itype(k+1))
6708 if (l.lt.nres-1) then
6709 itl1=itortyp(itype(l+1))
6714 s1=dip(4,jj,i)*dip(4,kk,k)
6716 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6717 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6718 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6719 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6720 call transpose2(EE(1,1,itk),auxmat(1,1))
6721 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6722 vv(1)=pizda(1,1)+pizda(2,2)
6723 vv(2)=pizda(2,1)-pizda(1,2)
6724 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6725 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6727 eello6_graph3=-(s1+s2+s3+s4)
6729 eello6_graph3=-(s2+s3+s4)
6732 if (.not. calc_grad) return
6733 C Derivatives in gamma(k-1)
6734 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6735 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6736 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6737 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6738 C Derivatives in gamma(l-1)
6739 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6740 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6741 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6742 vv(1)=pizda(1,1)+pizda(2,2)
6743 vv(2)=pizda(2,1)-pizda(1,2)
6744 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6745 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6746 C Cartesian derivatives.
6752 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6754 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6757 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6759 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6760 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6762 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6763 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6765 vv(1)=pizda(1,1)+pizda(2,2)
6766 vv(2)=pizda(2,1)-pizda(1,2)
6767 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6769 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6771 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6774 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6776 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6778 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6784 c----------------------------------------------------------------------------
6785 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6786 implicit real*8 (a-h,o-z)
6787 include 'DIMENSIONS'
6788 include 'DIMENSIONS.ZSCOPT'
6789 include 'COMMON.IOUNITS'
6790 include 'COMMON.CHAIN'
6791 include 'COMMON.DERIV'
6792 include 'COMMON.INTERACT'
6793 include 'COMMON.CONTACTS'
6794 include 'COMMON.TORSION'
6795 include 'COMMON.VAR'
6796 include 'COMMON.GEO'
6797 include 'COMMON.FFIELD'
6798 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6799 & auxvec1(2),auxmat1(2,2)
6801 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6803 C Parallel Antiparallel C
6809 C \ j|/k\| \ |/k\|l C
6814 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6816 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6817 C energy moment and not to the cluster cumulant.
6818 cd write (2,*) 'eello_graph4: wturn6',wturn6
6819 iti=itortyp(itype(i))
6820 itj=itortyp(itype(j))
6821 if (j.lt.nres-1) then
6822 itj1=itortyp(itype(j+1))
6826 itk=itortyp(itype(k))
6827 if (k.lt.nres-1) then
6828 itk1=itortyp(itype(k+1))
6832 itl=itortyp(itype(l))
6833 if (l.lt.nres-1) then
6834 itl1=itortyp(itype(l+1))
6838 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6839 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6840 cd & ' itl',itl,' itl1',itl1
6843 s1=dip(3,jj,i)*dip(3,kk,k)
6845 s1=dip(2,jj,j)*dip(2,kk,l)
6848 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6849 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6851 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6852 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6854 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6855 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6857 call transpose2(EUg(1,1,k),auxmat(1,1))
6858 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6859 vv(1)=pizda(1,1)-pizda(2,2)
6860 vv(2)=pizda(2,1)+pizda(1,2)
6861 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6862 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6864 eello6_graph4=-(s1+s2+s3+s4)
6866 eello6_graph4=-(s2+s3+s4)
6868 if (.not. calc_grad) return
6869 C Derivatives in gamma(i-1)
6873 s1=dipderg(2,jj,i)*dip(3,kk,k)
6875 s1=dipderg(4,jj,j)*dip(2,kk,l)
6878 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6880 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6881 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6883 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6884 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6886 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6887 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6888 cd write (2,*) 'turn6 derivatives'
6890 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6892 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6896 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6898 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6902 C Derivatives in gamma(k-1)
6905 s1=dip(3,jj,i)*dipderg(2,kk,k)
6907 s1=dip(2,jj,j)*dipderg(4,kk,l)
6910 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6911 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6913 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6914 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6916 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6917 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6919 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6920 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6921 vv(1)=pizda(1,1)-pizda(2,2)
6922 vv(2)=pizda(2,1)+pizda(1,2)
6923 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6924 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6926 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6928 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6932 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6934 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6937 C Derivatives in gamma(j-1) or gamma(l-1)
6938 if (l.eq.j+1 .and. l.gt.1) then
6939 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6940 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6941 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6942 vv(1)=pizda(1,1)-pizda(2,2)
6943 vv(2)=pizda(2,1)+pizda(1,2)
6944 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6945 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6946 else if (j.gt.1) then
6947 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6948 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6949 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6950 vv(1)=pizda(1,1)-pizda(2,2)
6951 vv(2)=pizda(2,1)+pizda(1,2)
6952 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6953 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6954 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6956 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6959 C Cartesian derivatives.
6966 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6968 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6972 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6974 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6978 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6980 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6982 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6983 & b1(1,itj1),auxvec(1))
6984 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6986 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6987 & b1(1,itl1),auxvec(1))
6988 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6990 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6992 vv(1)=pizda(1,1)-pizda(2,2)
6993 vv(2)=pizda(2,1)+pizda(1,2)
6994 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6996 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6998 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7001 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7004 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7007 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7009 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7011 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7015 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7017 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7020 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7022 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7030 c----------------------------------------------------------------------------
7031 double precision function eello_turn6(i,jj,kk)
7032 implicit real*8 (a-h,o-z)
7033 include 'DIMENSIONS'
7034 include 'DIMENSIONS.ZSCOPT'
7035 include 'COMMON.IOUNITS'
7036 include 'COMMON.CHAIN'
7037 include 'COMMON.DERIV'
7038 include 'COMMON.INTERACT'
7039 include 'COMMON.CONTACTS'
7040 include 'COMMON.TORSION'
7041 include 'COMMON.VAR'
7042 include 'COMMON.GEO'
7043 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7044 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7046 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7047 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7048 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7049 C the respective energy moment and not to the cluster cumulant.
7054 iti=itortyp(itype(i))
7055 itk=itortyp(itype(k))
7056 itk1=itortyp(itype(k+1))
7057 itl=itortyp(itype(l))
7058 itj=itortyp(itype(j))
7059 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7060 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7061 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7066 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7068 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7072 derx_turn(lll,kkk,iii)=0.0d0
7079 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7081 cd write (2,*) 'eello6_5',eello6_5
7083 call transpose2(AEA(1,1,1),auxmat(1,1))
7084 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7085 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7086 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7090 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7091 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7092 s2 = scalar2(b1(1,itk),vtemp1(1))
7094 call transpose2(AEA(1,1,2),atemp(1,1))
7095 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7096 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7097 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7101 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7102 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7103 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7105 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7106 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7107 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7108 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7109 ss13 = scalar2(b1(1,itk),vtemp4(1))
7110 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7114 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7120 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7122 C Derivatives in gamma(i+2)
7124 call transpose2(AEA(1,1,1),auxmatd(1,1))
7125 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7126 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7127 call transpose2(AEAderg(1,1,2),atempd(1,1))
7128 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7129 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7133 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7134 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7135 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7141 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7142 C Derivatives in gamma(i+3)
7144 call transpose2(AEA(1,1,1),auxmatd(1,1))
7145 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7146 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7147 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7151 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7152 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7153 s2d = scalar2(b1(1,itk),vtemp1d(1))
7155 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7156 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7158 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7160 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7161 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7162 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7172 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7173 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7175 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7176 & -0.5d0*ekont*(s2d+s12d)
7178 C Derivatives in gamma(i+4)
7179 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7180 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7181 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7183 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7184 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7185 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7195 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7197 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7199 C Derivatives in gamma(i+5)
7201 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7202 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7203 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7207 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7208 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7209 s2d = scalar2(b1(1,itk),vtemp1d(1))
7211 call transpose2(AEA(1,1,2),atempd(1,1))
7212 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7213 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7217 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7218 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7220 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7221 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7222 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7232 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7233 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7235 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7236 & -0.5d0*ekont*(s2d+s12d)
7238 C Cartesian derivatives
7243 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7244 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7245 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7249 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7250 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7252 s2d = scalar2(b1(1,itk),vtemp1d(1))
7254 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7255 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7256 s8d = -(atempd(1,1)+atempd(2,2))*
7257 & scalar2(cc(1,1,itl),vtemp2(1))
7261 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7263 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7264 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7271 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7274 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7278 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7279 & - 0.5d0*(s8d+s12d)
7281 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7290 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7292 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7293 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7294 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7295 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7296 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7298 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7299 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7300 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7304 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7305 cd & 16*eel_turn6_num
7307 if (j.lt.nres-1) then
7314 if (l.lt.nres-1) then
7322 ggg1(ll)=eel_turn6*g_contij(ll,1)
7323 ggg2(ll)=eel_turn6*g_contij(ll,2)
7324 ghalf=0.5d0*ggg1(ll)
7326 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7327 & +ekont*derx_turn(ll,2,1)
7328 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7329 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7330 & +ekont*derx_turn(ll,4,1)
7331 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7332 ghalf=0.5d0*ggg2(ll)
7334 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7335 & +ekont*derx_turn(ll,2,2)
7336 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7337 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7338 & +ekont*derx_turn(ll,4,2)
7339 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7344 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7349 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7355 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7360 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7364 cd write (2,*) iii,g_corr6_loc(iii)
7367 eello_turn6=ekont*eel_turn6
7368 cd write (2,*) 'ekont',ekont
7369 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7372 crc-------------------------------------------------
7373 SUBROUTINE MATVEC2(A1,V1,V2)
7374 implicit real*8 (a-h,o-z)
7375 include 'DIMENSIONS'
7376 DIMENSION A1(2,2),V1(2),V2(2)
7380 c 3 VI=VI+A1(I,K)*V1(K)
7384 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7385 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7390 C---------------------------------------
7391 SUBROUTINE MATMAT2(A1,A2,A3)
7392 implicit real*8 (a-h,o-z)
7393 include 'DIMENSIONS'
7394 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7395 c DIMENSION AI3(2,2)
7399 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7405 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7406 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7407 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7408 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7416 c-------------------------------------------------------------------------
7417 double precision function scalar2(u,v)
7419 double precision u(2),v(2)
7422 scalar2=u(1)*v(1)+u(2)*v(2)
7426 C-----------------------------------------------------------------------------
7428 subroutine transpose2(a,at)
7430 double precision a(2,2),at(2,2)
7437 c--------------------------------------------------------------------------
7438 subroutine transpose(n,a,at)
7441 double precision a(n,n),at(n,n)
7449 C---------------------------------------------------------------------------
7450 subroutine prodmat3(a1,a2,kk,transp,prod)
7453 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7455 crc double precision auxmat(2,2),prod_(2,2)
7458 crc call transpose2(kk(1,1),auxmat(1,1))
7459 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7460 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7462 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7463 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7464 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7465 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7466 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7467 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7468 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7469 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7472 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7473 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7475 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7476 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7477 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7478 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7479 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7480 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7481 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7482 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7485 c call transpose2(a2(1,1),a2t(1,1))
7488 crc print *,((prod_(i,j),i=1,2),j=1,2)
7489 crc print *,((prod(i,j),i=1,2),j=1,2)
7493 C-----------------------------------------------------------------------------
7494 double precision function scalar(u,v)
7496 double precision u(3),v(3)