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
160 if (isnan(etot).ne.0) energia(0)=1.0d+99
162 if (isnan(etot)) energia(0)=1.0d+99
167 idumm=proc_proc(etot,i)
169 call proc_proc(etot,i)
171 if(i.eq.1)energia(0)=1.0d+99
178 C Sum up the components of the Cartesian gradient.
183 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
184 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
186 & wstrain*ghpbc(j,i)+
187 & wcorr*fact(3)*gradcorr(j,i)+
188 & wel_loc*fact(2)*gel_loc(j,i)+
189 & wturn3*fact(2)*gcorr3_turn(j,i)+
190 & wturn4*fact(3)*gcorr4_turn(j,i)+
191 & wcorr5*fact(4)*gradcorr5(j,i)+
192 & wcorr6*fact(5)*gradcorr6(j,i)+
193 & wturn6*fact(5)*gcorr6_turn(j,i)+
194 & wsccor*fact(2)*gsccorc(j,i)
195 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
197 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
198 & wsccor*fact(2)*gsccorx(j,i)
203 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
204 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
206 & wcorr*fact(3)*gradcorr(j,i)+
207 & wel_loc*fact(2)*gel_loc(j,i)+
208 & wturn3*fact(2)*gcorr3_turn(j,i)+
209 & wturn4*fact(3)*gcorr4_turn(j,i)+
210 & wcorr5*fact(4)*gradcorr5(j,i)+
211 & wcorr6*fact(5)*gradcorr6(j,i)+
212 & wturn6*fact(5)*gcorr6_turn(j,i)+
213 & wsccor*fact(2)*gsccorc(j,i)
214 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
216 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
217 & wsccor*fact(1)*gsccorx(j,i)
224 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
225 & +wcorr5*fact(4)*g_corr5_loc(i)
226 & +wcorr6*fact(5)*g_corr6_loc(i)
227 & +wturn4*fact(3)*gel_loc_turn4(i)
228 & +wturn3*fact(2)*gel_loc_turn3(i)
229 & +wturn6*fact(5)*gel_loc_turn6(i)
230 & +wel_loc*fact(2)*gel_loc_loc(i)
231 c & +wsccor*fact(1)*gsccor_loc(i)
232 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
235 if (dyn_ss) call dyn_set_nss
238 C------------------------------------------------------------------------
239 subroutine enerprint(energia,fact)
240 implicit real*8 (a-h,o-z)
242 include 'DIMENSIONS.ZSCOPT'
243 include 'COMMON.IOUNITS'
244 include 'COMMON.FFIELD'
245 include 'COMMON.SBRIDGE'
246 double precision energia(0:max_ene),fact(6)
248 evdw=energia(1)+fact(6)*energia(21)
250 evdw2=energia(2)+energia(17)
262 eello_turn3=energia(8)
263 eello_turn4=energia(9)
264 eello_turn6=energia(10)
271 edihcnstr=energia(20)
274 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
276 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
277 & etors_d,wtor_d*fact(2),ehpb,wstrain,
278 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
279 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
280 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
281 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
282 10 format (/'Virtual-chain energies:'//
283 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
284 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
285 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
286 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
287 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
288 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
289 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
290 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
291 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
292 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
293 & ' (SS bridges & dist. cnstr.)'/
294 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
297 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
298 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
299 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
300 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
301 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
302 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
303 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
304 & 'ETOT= ',1pE16.6,' (total)')
306 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
307 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
308 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
309 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
310 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
311 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
312 & edihcnstr,ebr*nss,etot
313 10 format (/'Virtual-chain energies:'//
314 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
315 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
316 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
317 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
318 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
319 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
320 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
321 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
322 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
323 & ' (SS bridges & dist. cnstr.)'/
324 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
327 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
328 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
329 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
330 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
331 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
332 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
333 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
334 & 'ETOT= ',1pE16.6,' (total)')
338 C-----------------------------------------------------------------------
339 subroutine elj(evdw,evdw_t)
341 C This subroutine calculates the interaction energy of nonbonded side chains
342 C assuming the LJ potential of interaction.
344 implicit real*8 (a-h,o-z)
346 include 'DIMENSIONS.ZSCOPT'
347 include "DIMENSIONS.COMPAR"
348 parameter (accur=1.0d-10)
351 include 'COMMON.LOCAL'
352 include 'COMMON.CHAIN'
353 include 'COMMON.DERIV'
354 include 'COMMON.INTERACT'
355 include 'COMMON.TORSION'
356 include 'COMMON.ENEPS'
357 include 'COMMON.SBRIDGE'
358 include 'COMMON.NAMES'
359 include 'COMMON.IOUNITS'
360 include 'COMMON.CONTACTS'
364 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
368 eneps_temp(j,i)=0.0d0
377 if (itypi.eq.ntyp1) cycle
378 itypi1=iabs(itype(i+1))
385 C Calculate SC interaction energy.
388 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
389 cd & 'iend=',iend(i,iint)
390 do j=istart(i,iint),iend(i,iint)
392 if (itypj.eq.ntyp1) cycle
396 C Change 12/1/95 to calculate four-body interactions
397 rij=xj*xj+yj*yj+zj*zj
399 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
400 eps0ij=eps(itypi,itypj)
402 e1=fac*fac*aa(itypi,itypj)
403 e2=fac*bb(itypi,itypj)
405 ij=icant(itypi,itypj)
407 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
408 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
411 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
412 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
413 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
414 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
415 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
416 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
417 if (bb(itypi,itypj).gt.0.0d0) then
424 C Calculate the components of the gradient in DC and X
426 fac=-rrij*(e1+evdwij)
431 gvdwx(k,i)=gvdwx(k,i)-gg(k)
432 gvdwx(k,j)=gvdwx(k,j)+gg(k)
436 gvdwc(l,k)=gvdwc(l,k)+gg(l)
441 C 12/1/95, revised on 5/20/97
443 C Calculate the contact function. The ith column of the array JCONT will
444 C contain the numbers of atoms that make contacts with the atom I (of numbers
445 C greater than I). The arrays FACONT and GACONT will contain the values of
446 C the contact function and its derivative.
448 C Uncomment next line, if the correlation interactions include EVDW explicitly.
449 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
450 C Uncomment next line, if the correlation interactions are contact function only
451 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
453 sigij=sigma(itypi,itypj)
454 r0ij=rs0(itypi,itypj)
456 C Check whether the SC's are not too far to make a contact.
459 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
460 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
462 if (fcont.gt.0.0D0) then
463 C If the SC-SC distance if close to sigma, apply spline.
464 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
465 cAdam & fcont1,fprimcont1)
466 cAdam fcont1=1.0d0-fcont1
467 cAdam if (fcont1.gt.0.0d0) then
468 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
469 cAdam fcont=fcont*fcont1
471 C Uncomment following 4 lines to have the geometric average of the epsilon0's
472 cga eps0ij=1.0d0/dsqrt(eps0ij)
474 cga gg(k)=gg(k)*eps0ij
476 cga eps0ij=-evdwij*eps0ij
477 C Uncomment for AL's type of SC correlation interactions.
479 num_conti=num_conti+1
481 facont(num_conti,i)=fcont*eps0ij
482 fprimcont=eps0ij*fprimcont/rij
484 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
485 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
486 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
487 C Uncomment following 3 lines for Skolnick's type of SC correlation.
488 gacont(1,num_conti,i)=-fprimcont*xj
489 gacont(2,num_conti,i)=-fprimcont*yj
490 gacont(3,num_conti,i)=-fprimcont*zj
491 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
492 cd write (iout,'(2i3,3f10.5)')
493 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
499 num_cont(i)=num_conti
504 gvdwc(j,i)=expon*gvdwc(j,i)
505 gvdwx(j,i)=expon*gvdwx(j,i)
509 C******************************************************************************
513 C To save time, the factor of EXPON has been extracted from ALL components
514 C of GVDWC and GRADX. Remember to multiply them by this factor before further
517 C******************************************************************************
520 C-----------------------------------------------------------------------------
521 subroutine eljk(evdw,evdw_t)
523 C This subroutine calculates the interaction energy of nonbonded side chains
524 C assuming the LJK potential of interaction.
526 implicit real*8 (a-h,o-z)
528 include 'DIMENSIONS.ZSCOPT'
529 include "DIMENSIONS.COMPAR"
532 include 'COMMON.LOCAL'
533 include 'COMMON.CHAIN'
534 include 'COMMON.DERIV'
535 include 'COMMON.INTERACT'
536 include 'COMMON.ENEPS'
537 include 'COMMON.IOUNITS'
538 include 'COMMON.NAMES'
543 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
546 eneps_temp(j,i)=0.0d0
553 if (itypi.eq.ntyp1) cycle
554 itypi1=iabs(itype(i+1))
559 C Calculate SC interaction energy.
562 do j=istart(i,iint),iend(i,iint)
564 if (itypj.eq.ntyp1) cycle
568 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
570 e_augm=augm(itypi,itypj)*fac_augm
573 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
574 fac=r_shift_inv**expon
575 e1=fac*fac*aa(itypi,itypj)
576 e2=fac*bb(itypi,itypj)
578 ij=icant(itypi,itypj)
579 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
580 & /dabs(eps(itypi,itypj))
581 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
582 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
583 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
584 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
585 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
586 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
587 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
588 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
589 if (bb(itypi,itypj).gt.0.0d0) then
596 C Calculate the components of the gradient in DC and X
598 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
603 gvdwx(k,i)=gvdwx(k,i)-gg(k)
604 gvdwx(k,j)=gvdwx(k,j)+gg(k)
608 gvdwc(l,k)=gvdwc(l,k)+gg(l)
618 gvdwc(j,i)=expon*gvdwc(j,i)
619 gvdwx(j,i)=expon*gvdwx(j,i)
625 C-----------------------------------------------------------------------------
626 subroutine ebp(evdw,evdw_t)
628 C This subroutine calculates the interaction energy of nonbonded side chains
629 C assuming the Berne-Pechukas potential of interaction.
631 implicit real*8 (a-h,o-z)
633 include 'DIMENSIONS.ZSCOPT'
634 include "DIMENSIONS.COMPAR"
637 include 'COMMON.LOCAL'
638 include 'COMMON.CHAIN'
639 include 'COMMON.DERIV'
640 include 'COMMON.NAMES'
641 include 'COMMON.INTERACT'
642 include 'COMMON.ENEPS'
643 include 'COMMON.IOUNITS'
644 include 'COMMON.CALC'
646 c double precision rrsave(maxdim)
652 eneps_temp(j,i)=0.0d0
657 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
658 c if (icall.eq.0) then
666 if (itypi.eq.ntyp1) cycle
667 itypi1=iabs(itype(i+1))
671 dxi=dc_norm(1,nres+i)
672 dyi=dc_norm(2,nres+i)
673 dzi=dc_norm(3,nres+i)
674 dsci_inv=vbld_inv(i+nres)
676 C Calculate SC interaction energy.
679 do j=istart(i,iint),iend(i,iint)
682 if (itypj.eq.ntyp1) cycle
683 dscj_inv=vbld_inv(j+nres)
684 chi1=chi(itypi,itypj)
685 chi2=chi(itypj,itypi)
692 alf12=0.5D0*(alf1+alf2)
693 C For diagnostics only!!!
706 dxj=dc_norm(1,nres+j)
707 dyj=dc_norm(2,nres+j)
708 dzj=dc_norm(3,nres+j)
709 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
710 cd if (icall.eq.0) then
716 C Calculate the angle-dependent terms of energy & contributions to derivatives.
718 C Calculate whole angle-dependent part of epsilon and contributions
720 fac=(rrij*sigsq)**expon2
721 e1=fac*fac*aa(itypi,itypj)
722 e2=fac*bb(itypi,itypj)
723 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
724 eps2der=evdwij*eps3rt
725 eps3der=evdwij*eps2rt
726 evdwij=evdwij*eps2rt*eps3rt
727 ij=icant(itypi,itypj)
728 aux=eps1*eps2rt**2*eps3rt**2
729 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
730 & /dabs(eps(itypi,itypj))
731 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
732 if (bb(itypi,itypj).gt.0.0d0) then
739 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
740 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
741 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
742 & restyp(itypi),i,restyp(itypj),j,
743 & epsi,sigm,chi1,chi2,chip1,chip2,
744 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
745 & om1,om2,om12,1.0D0/dsqrt(rrij),
748 C Calculate gradient components.
749 e1=e1*eps1*eps2rt**2*eps3rt**2
750 fac=-expon*(e1+evdwij)
753 C Calculate radial part of the gradient
757 C Calculate the angular part of the gradient and sum add the contributions
758 C to the appropriate components of the Cartesian gradient.
767 C-----------------------------------------------------------------------------
768 subroutine egb(evdw,evdw_t)
770 C This subroutine calculates the interaction energy of nonbonded side chains
771 C assuming the Gay-Berne potential of interaction.
773 implicit real*8 (a-h,o-z)
775 include 'DIMENSIONS.ZSCOPT'
776 include "DIMENSIONS.COMPAR"
779 include 'COMMON.LOCAL'
780 include 'COMMON.CHAIN'
781 include 'COMMON.DERIV'
782 include 'COMMON.NAMES'
783 include 'COMMON.INTERACT'
784 include 'COMMON.ENEPS'
785 include 'COMMON.IOUNITS'
786 include 'COMMON.CALC'
787 include 'COMMON.SBRIDGE'
794 eneps_temp(j,i)=0.0d0
797 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
801 c if (icall.gt.0) lprn=.true.
805 if (itypi.eq.ntyp1) cycle
806 itypi1=iabs(itype(i+1))
810 dxi=dc_norm(1,nres+i)
811 dyi=dc_norm(2,nres+i)
812 dzi=dc_norm(3,nres+i)
813 dsci_inv=vbld_inv(i+nres)
815 C Calculate SC interaction energy.
818 do j=istart(i,iint),iend(i,iint)
819 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
820 call dyn_ssbond_ene(i,j,evdwij)
822 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
823 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
824 C triple bond artifac removal
825 do k=j+1,iend(i,iint)
826 C search over all next residues
827 if (dyn_ss_mask(k)) then
828 C check if they are cysteins
829 C write(iout,*) 'k=',k
830 call triple_ssbond_ene(i,j,k,evdwij)
831 C call the energy function that removes the artifical triple disulfide
832 C bond the soubroutine is located in ssMD.F
834 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
835 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
841 if (itypj.eq.ntyp1) cycle
842 dscj_inv=vbld_inv(j+nres)
843 sig0ij=sigma(itypi,itypj)
844 chi1=chi(itypi,itypj)
845 chi2=chi(itypj,itypi)
852 alf12=0.5D0*(alf1+alf2)
853 C For diagnostics only!!!
866 dxj=dc_norm(1,nres+j)
867 dyj=dc_norm(2,nres+j)
868 dzj=dc_norm(3,nres+j)
869 c write (iout,*) i,j,xj,yj,zj
870 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
872 C Calculate angle-dependent terms of energy and contributions to their
876 sig=sig0ij*dsqrt(sigsq)
877 rij_shift=1.0D0/rij-sig+sig0ij
878 C I hate to put IF's in the loops, but here don't have another choice!!!!
879 if (rij_shift.le.0.0D0) then
884 c---------------------------------------------------------------
885 rij_shift=1.0D0/rij_shift
887 e1=fac*fac*aa(itypi,itypj)
888 e2=fac*bb(itypi,itypj)
889 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
890 eps2der=evdwij*eps3rt
891 eps3der=evdwij*eps2rt
892 evdwij=evdwij*eps2rt*eps3rt
893 if (bb(itypi,itypj).gt.0) then
898 ij=icant(itypi,itypj)
899 aux=eps1*eps2rt**2*eps3rt**2
900 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
901 & /dabs(eps(itypi,itypj))
902 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
903 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
904 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
905 c & aux*e2/eps(itypi,itypj)
907 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
908 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
910 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
911 & restyp(itypi),i,restyp(itypj),j,
912 & epsi,sigm,chi1,chi2,chip1,chip2,
913 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
914 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
916 write (iout,*) "partial sum", evdw, evdw_t
920 C Calculate gradient components.
921 e1=e1*eps1*eps2rt**2*eps3rt**2
922 fac=-expon*(e1+evdwij)*rij_shift
925 C Calculate the radial part of the gradient
929 C Calculate angular part of the gradient.
932 C write(iout,*) "partial sum", evdw, evdw_t
939 C-----------------------------------------------------------------------------
940 subroutine egbv(evdw,evdw_t)
942 C This subroutine calculates the interaction energy of nonbonded side chains
943 C assuming the Gay-Berne-Vorobjev potential of interaction.
945 implicit real*8 (a-h,o-z)
947 include 'DIMENSIONS.ZSCOPT'
948 include "DIMENSIONS.COMPAR"
951 include 'COMMON.LOCAL'
952 include 'COMMON.CHAIN'
953 include 'COMMON.DERIV'
954 include 'COMMON.NAMES'
955 include 'COMMON.INTERACT'
956 include 'COMMON.ENEPS'
957 include 'COMMON.IOUNITS'
958 include 'COMMON.CALC'
965 eneps_temp(j,i)=0.0d0
970 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
973 c if (icall.gt.0) lprn=.true.
977 if (itypi.eq.ntyp1) cycle
978 itypi1=iabs(itype(i+1))
982 dxi=dc_norm(1,nres+i)
983 dyi=dc_norm(2,nres+i)
984 dzi=dc_norm(3,nres+i)
985 dsci_inv=vbld_inv(i+nres)
987 C Calculate SC interaction energy.
990 do j=istart(i,iint),iend(i,iint)
993 if (itypj.eq.ntyp1) cycle
994 dscj_inv=vbld_inv(j+nres)
995 sig0ij=sigma(itypi,itypj)
997 chi1=chi(itypi,itypj)
998 chi2=chi(itypj,itypi)
1005 alf12=0.5D0*(alf1+alf2)
1006 C For diagnostics only!!!
1019 dxj=dc_norm(1,nres+j)
1020 dyj=dc_norm(2,nres+j)
1021 dzj=dc_norm(3,nres+j)
1022 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1024 C Calculate angle-dependent terms of energy and contributions to their
1028 sig=sig0ij*dsqrt(sigsq)
1029 rij_shift=1.0D0/rij-sig+r0ij
1030 C I hate to put IF's in the loops, but here don't have another choice!!!!
1031 if (rij_shift.le.0.0D0) then
1036 c---------------------------------------------------------------
1037 rij_shift=1.0D0/rij_shift
1038 fac=rij_shift**expon
1039 e1=fac*fac*aa(itypi,itypj)
1040 e2=fac*bb(itypi,itypj)
1041 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1042 eps2der=evdwij*eps3rt
1043 eps3der=evdwij*eps2rt
1044 fac_augm=rrij**expon
1045 e_augm=augm(itypi,itypj)*fac_augm
1046 evdwij=evdwij*eps2rt*eps3rt
1047 if (bb(itypi,itypj).gt.0.0d0) then
1048 evdw=evdw+evdwij+e_augm
1050 evdw_t=evdw_t+evdwij+e_augm
1052 ij=icant(itypi,itypj)
1053 aux=eps1*eps2rt**2*eps3rt**2
1054 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1055 & /dabs(eps(itypi,itypj))
1056 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1057 c eneps_temp(ij)=eneps_temp(ij)
1058 c & +(evdwij+e_augm)/eps(itypi,itypj)
1060 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1061 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1062 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1063 c & restyp(itypi),i,restyp(itypj),j,
1064 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1065 c & chi1,chi2,chip1,chip2,
1066 c & eps1,eps2rt**2,eps3rt**2,
1067 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1071 C Calculate gradient components.
1072 e1=e1*eps1*eps2rt**2*eps3rt**2
1073 fac=-expon*(e1+evdwij)*rij_shift
1075 fac=rij*fac-2*expon*rrij*e_augm
1076 C Calculate the radial part of the gradient
1080 C Calculate angular part of the gradient.
1088 C-----------------------------------------------------------------------------
1089 subroutine sc_angular
1090 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1091 C om12. Called by ebp, egb, and egbv.
1093 include 'COMMON.CALC'
1097 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1098 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1099 om12=dxi*dxj+dyi*dyj+dzi*dzj
1101 C Calculate eps1(om12) and its derivative in om12
1102 faceps1=1.0D0-om12*chiom12
1103 faceps1_inv=1.0D0/faceps1
1104 eps1=dsqrt(faceps1_inv)
1105 C Following variable is eps1*deps1/dom12
1106 eps1_om12=faceps1_inv*chiom12
1107 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1112 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1113 sigsq=1.0D0-facsig*faceps1_inv
1114 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1115 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1116 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1117 C Calculate eps2 and its derivatives in om1, om2, and om12.
1120 chipom12=chip12*om12
1121 facp=1.0D0-om12*chipom12
1123 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1124 C Following variable is the square root of eps2
1125 eps2rt=1.0D0-facp1*facp_inv
1126 C Following three variables are the derivatives of the square root of eps
1127 C in om1, om2, and om12.
1128 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1129 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1130 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1131 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1132 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1133 C Calculate whole angle-dependent part of epsilon and contributions
1134 C to its derivatives
1137 C----------------------------------------------------------------------------
1139 implicit real*8 (a-h,o-z)
1140 include 'DIMENSIONS'
1141 include 'DIMENSIONS.ZSCOPT'
1142 include 'COMMON.CHAIN'
1143 include 'COMMON.DERIV'
1144 include 'COMMON.CALC'
1145 double precision dcosom1(3),dcosom2(3)
1146 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1147 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1148 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1149 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1151 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1152 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1155 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1158 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1159 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1160 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1161 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1162 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1163 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1166 C Calculate the components of the gradient in DC and X
1170 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1175 c------------------------------------------------------------------------------
1176 subroutine vec_and_deriv
1177 implicit real*8 (a-h,o-z)
1178 include 'DIMENSIONS'
1179 include 'DIMENSIONS.ZSCOPT'
1180 include 'COMMON.IOUNITS'
1181 include 'COMMON.GEO'
1182 include 'COMMON.VAR'
1183 include 'COMMON.LOCAL'
1184 include 'COMMON.CHAIN'
1185 include 'COMMON.VECTORS'
1186 include 'COMMON.DERIV'
1187 include 'COMMON.INTERACT'
1188 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1189 C Compute the local reference systems. For reference system (i), the
1190 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1191 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1193 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1194 if (i.eq.nres-1) then
1195 C Case of the last full residue
1196 C Compute the Z-axis
1197 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1198 costh=dcos(pi-theta(nres))
1199 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1204 C Compute the derivatives of uz
1206 uzder(2,1,1)=-dc_norm(3,i-1)
1207 uzder(3,1,1)= dc_norm(2,i-1)
1208 uzder(1,2,1)= dc_norm(3,i-1)
1210 uzder(3,2,1)=-dc_norm(1,i-1)
1211 uzder(1,3,1)=-dc_norm(2,i-1)
1212 uzder(2,3,1)= dc_norm(1,i-1)
1215 uzder(2,1,2)= dc_norm(3,i)
1216 uzder(3,1,2)=-dc_norm(2,i)
1217 uzder(1,2,2)=-dc_norm(3,i)
1219 uzder(3,2,2)= dc_norm(1,i)
1220 uzder(1,3,2)= dc_norm(2,i)
1221 uzder(2,3,2)=-dc_norm(1,i)
1224 C Compute the Y-axis
1227 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1230 C Compute the derivatives of uy
1233 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1234 & -dc_norm(k,i)*dc_norm(j,i-1)
1235 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1237 uyder(j,j,1)=uyder(j,j,1)-costh
1238 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1243 uygrad(l,k,j,i)=uyder(l,k,j)
1244 uzgrad(l,k,j,i)=uzder(l,k,j)
1248 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1249 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1250 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1251 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1255 C Compute the Z-axis
1256 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1257 costh=dcos(pi-theta(i+2))
1258 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1263 C Compute the derivatives of uz
1265 uzder(2,1,1)=-dc_norm(3,i+1)
1266 uzder(3,1,1)= dc_norm(2,i+1)
1267 uzder(1,2,1)= dc_norm(3,i+1)
1269 uzder(3,2,1)=-dc_norm(1,i+1)
1270 uzder(1,3,1)=-dc_norm(2,i+1)
1271 uzder(2,3,1)= dc_norm(1,i+1)
1274 uzder(2,1,2)= dc_norm(3,i)
1275 uzder(3,1,2)=-dc_norm(2,i)
1276 uzder(1,2,2)=-dc_norm(3,i)
1278 uzder(3,2,2)= dc_norm(1,i)
1279 uzder(1,3,2)= dc_norm(2,i)
1280 uzder(2,3,2)=-dc_norm(1,i)
1283 C Compute the Y-axis
1286 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1289 C Compute the derivatives of uy
1292 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1293 & -dc_norm(k,i)*dc_norm(j,i+1)
1294 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1296 uyder(j,j,1)=uyder(j,j,1)-costh
1297 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1302 uygrad(l,k,j,i)=uyder(l,k,j)
1303 uzgrad(l,k,j,i)=uzder(l,k,j)
1307 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1308 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1309 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1310 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1316 vbld_inv_temp(1)=vbld_inv(i+1)
1317 if (i.lt.nres-1) then
1318 vbld_inv_temp(2)=vbld_inv(i+2)
1320 vbld_inv_temp(2)=vbld_inv(i)
1325 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1326 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1334 C-----------------------------------------------------------------------------
1335 subroutine vec_and_deriv_test
1336 implicit real*8 (a-h,o-z)
1337 include 'DIMENSIONS'
1338 include 'DIMENSIONS.ZSCOPT'
1339 include 'COMMON.IOUNITS'
1340 include 'COMMON.GEO'
1341 include 'COMMON.VAR'
1342 include 'COMMON.LOCAL'
1343 include 'COMMON.CHAIN'
1344 include 'COMMON.VECTORS'
1345 dimension uyder(3,3,2),uzder(3,3,2)
1346 C Compute the local reference systems. For reference system (i), the
1347 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1348 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1350 if (i.eq.nres-1) then
1351 C Case of the last full residue
1352 C Compute the Z-axis
1353 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1354 costh=dcos(pi-theta(nres))
1355 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1356 c write (iout,*) 'fac',fac,
1357 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1358 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1362 C Compute the derivatives of uz
1364 uzder(2,1,1)=-dc_norm(3,i-1)
1365 uzder(3,1,1)= dc_norm(2,i-1)
1366 uzder(1,2,1)= dc_norm(3,i-1)
1368 uzder(3,2,1)=-dc_norm(1,i-1)
1369 uzder(1,3,1)=-dc_norm(2,i-1)
1370 uzder(2,3,1)= dc_norm(1,i-1)
1373 uzder(2,1,2)= dc_norm(3,i)
1374 uzder(3,1,2)=-dc_norm(2,i)
1375 uzder(1,2,2)=-dc_norm(3,i)
1377 uzder(3,2,2)= dc_norm(1,i)
1378 uzder(1,3,2)= dc_norm(2,i)
1379 uzder(2,3,2)=-dc_norm(1,i)
1381 C Compute the Y-axis
1383 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1386 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1387 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1388 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1390 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1393 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1394 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1397 c write (iout,*) 'facy',facy,
1398 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1399 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1401 uy(k,i)=facy*uy(k,i)
1403 C Compute the derivatives of uy
1406 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1407 & -dc_norm(k,i)*dc_norm(j,i-1)
1408 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1410 c uyder(j,j,1)=uyder(j,j,1)-costh
1411 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1412 uyder(j,j,1)=uyder(j,j,1)
1413 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1414 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1420 uygrad(l,k,j,i)=uyder(l,k,j)
1421 uzgrad(l,k,j,i)=uzder(l,k,j)
1425 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1426 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1427 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1428 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1431 C Compute the Z-axis
1432 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1433 costh=dcos(pi-theta(i+2))
1434 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1435 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1439 C Compute the derivatives of uz
1441 uzder(2,1,1)=-dc_norm(3,i+1)
1442 uzder(3,1,1)= dc_norm(2,i+1)
1443 uzder(1,2,1)= dc_norm(3,i+1)
1445 uzder(3,2,1)=-dc_norm(1,i+1)
1446 uzder(1,3,1)=-dc_norm(2,i+1)
1447 uzder(2,3,1)= dc_norm(1,i+1)
1450 uzder(2,1,2)= dc_norm(3,i)
1451 uzder(3,1,2)=-dc_norm(2,i)
1452 uzder(1,2,2)=-dc_norm(3,i)
1454 uzder(3,2,2)= dc_norm(1,i)
1455 uzder(1,3,2)= dc_norm(2,i)
1456 uzder(2,3,2)=-dc_norm(1,i)
1458 C Compute the Y-axis
1460 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1461 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1462 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1464 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1467 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1468 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1471 c write (iout,*) 'facy',facy,
1472 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1473 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1475 uy(k,i)=facy*uy(k,i)
1477 C Compute the derivatives of uy
1480 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1481 & -dc_norm(k,i)*dc_norm(j,i+1)
1482 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1484 c uyder(j,j,1)=uyder(j,j,1)-costh
1485 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1486 uyder(j,j,1)=uyder(j,j,1)
1487 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1488 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1494 uygrad(l,k,j,i)=uyder(l,k,j)
1495 uzgrad(l,k,j,i)=uzder(l,k,j)
1499 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1500 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1501 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1502 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1509 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1510 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1517 C-----------------------------------------------------------------------------
1518 subroutine check_vecgrad
1519 implicit real*8 (a-h,o-z)
1520 include 'DIMENSIONS'
1521 include 'DIMENSIONS.ZSCOPT'
1522 include 'COMMON.IOUNITS'
1523 include 'COMMON.GEO'
1524 include 'COMMON.VAR'
1525 include 'COMMON.LOCAL'
1526 include 'COMMON.CHAIN'
1527 include 'COMMON.VECTORS'
1528 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1529 dimension uyt(3,maxres),uzt(3,maxres)
1530 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1531 double precision delta /1.0d-7/
1534 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1535 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1536 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1537 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1538 cd & (dc_norm(if90,i),if90=1,3)
1539 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1540 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1541 cd write(iout,'(a)')
1547 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1548 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1561 cd write (iout,*) 'i=',i
1563 erij(k)=dc_norm(k,i)
1567 dc_norm(k,i)=erij(k)
1569 dc_norm(j,i)=dc_norm(j,i)+delta
1570 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1572 c dc_norm(k,i)=dc_norm(k,i)/fac
1574 c write (iout,*) (dc_norm(k,i),k=1,3)
1575 c write (iout,*) (erij(k),k=1,3)
1578 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1579 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1580 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1581 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1583 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1584 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1585 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1588 dc_norm(k,i)=erij(k)
1591 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1592 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1593 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1594 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1595 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1596 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1597 cd write (iout,'(a)')
1602 C--------------------------------------------------------------------------
1603 subroutine set_matrices
1604 implicit real*8 (a-h,o-z)
1605 include 'DIMENSIONS'
1606 include 'DIMENSIONS.ZSCOPT'
1607 include 'COMMON.IOUNITS'
1608 include 'COMMON.GEO'
1609 include 'COMMON.VAR'
1610 include 'COMMON.LOCAL'
1611 include 'COMMON.CHAIN'
1612 include 'COMMON.DERIV'
1613 include 'COMMON.INTERACT'
1614 include 'COMMON.CONTACTS'
1615 include 'COMMON.TORSION'
1616 include 'COMMON.VECTORS'
1617 include 'COMMON.FFIELD'
1618 double precision auxvec(2),auxmat(2,2)
1620 C Compute the virtual-bond-torsional-angle dependent quantities needed
1621 C to calculate the el-loc multibody terms of various order.
1624 if (i .lt. nres+1) then
1661 if (i .gt. 3 .and. i .lt. nres+1) then
1662 obrot_der(1,i-2)=-sin1
1663 obrot_der(2,i-2)= cos1
1664 Ugder(1,1,i-2)= sin1
1665 Ugder(1,2,i-2)=-cos1
1666 Ugder(2,1,i-2)=-cos1
1667 Ugder(2,2,i-2)=-sin1
1670 obrot2_der(1,i-2)=-dwasin2
1671 obrot2_der(2,i-2)= dwacos2
1672 Ug2der(1,1,i-2)= dwasin2
1673 Ug2der(1,2,i-2)=-dwacos2
1674 Ug2der(2,1,i-2)=-dwacos2
1675 Ug2der(2,2,i-2)=-dwasin2
1677 obrot_der(1,i-2)=0.0d0
1678 obrot_der(2,i-2)=0.0d0
1679 Ugder(1,1,i-2)=0.0d0
1680 Ugder(1,2,i-2)=0.0d0
1681 Ugder(2,1,i-2)=0.0d0
1682 Ugder(2,2,i-2)=0.0d0
1683 obrot2_der(1,i-2)=0.0d0
1684 obrot2_der(2,i-2)=0.0d0
1685 Ug2der(1,1,i-2)=0.0d0
1686 Ug2der(1,2,i-2)=0.0d0
1687 Ug2der(2,1,i-2)=0.0d0
1688 Ug2der(2,2,i-2)=0.0d0
1690 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1691 if (itype(i-2).le.ntyp) then
1692 iti = itortyp(itype(i-2))
1699 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1700 if (itype(i-1).le.ntyp) then
1701 iti1 = itortyp(itype(i-1))
1708 cd write (iout,*) '*******i',i,' iti1',iti
1709 cd write (iout,*) 'b1',b1(:,iti)
1710 cd write (iout,*) 'b2',b2(:,iti)
1711 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1712 c print *,"itilde1 i iti iti1",i,iti,iti1
1713 if (i .gt. iatel_s+2) then
1714 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1715 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1716 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1717 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1718 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1719 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1720 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1730 DtUg2(l,k,i-2)=0.0d0
1734 c print *,"itilde2 i iti iti1",i,iti,iti1
1735 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1736 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1737 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1738 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1739 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1740 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1741 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1742 c print *,"itilde3 i iti iti1",i,iti,iti1
1744 muder(k,i-2)=Ub2der(k,i-2)
1746 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1747 if (itype(i-1).le.ntyp) then
1748 iti1 = itortyp(itype(i-1))
1756 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1758 C Vectors and matrices dependent on a single virtual-bond dihedral.
1759 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1760 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1761 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1762 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1763 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1764 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1765 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1766 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1767 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1768 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1769 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1771 C Matrices dependent on two consecutive virtual-bond dihedrals.
1772 C The order of matrices is from left to right.
1774 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1775 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1776 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1777 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1778 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1779 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1780 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1781 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1784 cd iti = itortyp(itype(i))
1787 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1788 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1793 C--------------------------------------------------------------------------
1794 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1796 C This subroutine calculates the average interaction energy and its gradient
1797 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1798 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1799 C The potential depends both on the distance of peptide-group centers and on
1800 C the orientation of the CA-CA virtual bonds.
1802 implicit real*8 (a-h,o-z)
1803 include 'DIMENSIONS'
1804 include 'DIMENSIONS.ZSCOPT'
1805 include 'COMMON.CONTROL'
1806 include 'COMMON.IOUNITS'
1807 include 'COMMON.GEO'
1808 include 'COMMON.VAR'
1809 include 'COMMON.LOCAL'
1810 include 'COMMON.CHAIN'
1811 include 'COMMON.DERIV'
1812 include 'COMMON.INTERACT'
1813 include 'COMMON.CONTACTS'
1814 include 'COMMON.TORSION'
1815 include 'COMMON.VECTORS'
1816 include 'COMMON.FFIELD'
1817 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1818 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1819 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1820 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1821 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1822 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1823 double precision scal_el /0.5d0/
1825 C 13-go grudnia roku pamietnego...
1826 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1827 & 0.0d0,1.0d0,0.0d0,
1828 & 0.0d0,0.0d0,1.0d0/
1829 cd write(iout,*) 'In EELEC'
1831 cd write(iout,*) 'Type',i
1832 cd write(iout,*) 'B1',B1(:,i)
1833 cd write(iout,*) 'B2',B2(:,i)
1834 cd write(iout,*) 'CC',CC(:,:,i)
1835 cd write(iout,*) 'DD',DD(:,:,i)
1836 cd write(iout,*) 'EE',EE(:,:,i)
1838 cd call check_vecgrad
1840 if (icheckgrad.eq.1) then
1842 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1844 dc_norm(k,i)=dc(k,i)*fac
1846 c write (iout,*) 'i',i,' fac',fac
1849 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1850 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1851 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1852 cd if (wel_loc.gt.0.0d0) then
1853 if (icheckgrad.eq.1) then
1854 call vec_and_deriv_test
1861 cd write (iout,*) 'i=',i
1863 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1866 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1867 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1880 cd print '(a)','Enter EELEC'
1881 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1883 gel_loc_loc(i)=0.0d0
1886 do i=iatel_s,iatel_e
1887 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1888 if (itel(i).eq.0) goto 1215
1892 dx_normi=dc_norm(1,i)
1893 dy_normi=dc_norm(2,i)
1894 dz_normi=dc_norm(3,i)
1895 xmedi=c(1,i)+0.5d0*dxi
1896 ymedi=c(2,i)+0.5d0*dyi
1897 zmedi=c(3,i)+0.5d0*dzi
1899 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1900 do j=ielstart(i),ielend(i)
1901 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1902 if (itel(j).eq.0) goto 1216
1906 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1907 aaa=app(iteli,itelj)
1908 bbb=bpp(iteli,itelj)
1909 C Diagnostics only!!!
1915 ael6i=ael6(iteli,itelj)
1916 ael3i=ael3(iteli,itelj)
1920 dx_normj=dc_norm(1,j)
1921 dy_normj=dc_norm(2,j)
1922 dz_normj=dc_norm(3,j)
1923 xj=c(1,j)+0.5D0*dxj-xmedi
1924 yj=c(2,j)+0.5D0*dyj-ymedi
1925 zj=c(3,j)+0.5D0*dzj-zmedi
1926 rij=xj*xj+yj*yj+zj*zj
1932 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1933 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1934 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1935 fac=cosa-3.0D0*cosb*cosg
1937 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1938 if (j.eq.i+2) ev1=scal_el*ev1
1943 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1946 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1947 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1948 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1951 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
1952 c &'evdw1',i,j,evdwij
1953 c &,iteli,itelj,aaa,evdw1
1955 c write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
1956 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1957 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1958 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1959 c & xmedi,ymedi,zmedi,xj,yj,zj
1961 C Calculate contributions to the Cartesian gradient.
1964 facvdw=-6*rrmij*(ev1+evdwij)
1965 facel=-3*rrmij*(el1+eesij)
1972 * Radial derivatives. First process both termini of the fragment (i,j)
1979 gelc(k,i)=gelc(k,i)+ghalf
1980 gelc(k,j)=gelc(k,j)+ghalf
1983 * Loop over residues i+1 thru j-1.
1987 gelc(l,k)=gelc(l,k)+ggg(l)
1995 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1996 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1999 * Loop over residues i+1 thru j-1.
2003 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2010 fac=-3*rrmij*(facvdw+facvdw+facel)
2016 * Radial derivatives. First process both termini of the fragment (i,j)
2023 gelc(k,i)=gelc(k,i)+ghalf
2024 gelc(k,j)=gelc(k,j)+ghalf
2027 * Loop over residues i+1 thru j-1.
2031 gelc(l,k)=gelc(l,k)+ggg(l)
2038 ecosa=2.0D0*fac3*fac1+fac4
2041 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2042 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2044 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2045 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2047 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2048 cd & (dcosg(k),k=1,3)
2050 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2054 gelc(k,i)=gelc(k,i)+ghalf
2055 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2056 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2057 gelc(k,j)=gelc(k,j)+ghalf
2058 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2059 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2063 gelc(l,k)=gelc(l,k)+ggg(l)
2068 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2069 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2070 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2072 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2073 C energy of a peptide unit is assumed in the form of a second-order
2074 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2075 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2076 C are computed for EVERY pair of non-contiguous peptide groups.
2078 if (j.lt.nres-1) then
2089 muij(kkk)=mu(k,i)*mu(l,j)
2092 cd write (iout,*) 'EELEC: i',i,' j',j
2093 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2094 cd write(iout,*) 'muij',muij
2095 ury=scalar(uy(1,i),erij)
2096 urz=scalar(uz(1,i),erij)
2097 vry=scalar(uy(1,j),erij)
2098 vrz=scalar(uz(1,j),erij)
2099 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2100 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2101 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2102 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2103 C For diagnostics only
2108 fac=dsqrt(-ael6i)*r3ij
2109 cd write (2,*) 'fac=',fac
2110 C For diagnostics only
2116 cd write (iout,'(4i5,4f10.5)')
2117 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2118 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2119 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2120 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2121 cd write (iout,'(4f10.5)')
2122 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2123 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2124 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2125 cd write (iout,'(2i3,9f10.5/)') i,j,
2126 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2128 C Derivatives of the elements of A in virtual-bond vectors
2129 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2136 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2137 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2138 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2139 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2140 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2141 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2142 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2143 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2144 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2145 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2146 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2147 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2157 C Compute radial contributions to the gradient
2179 C Add the contributions coming from er
2182 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2183 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2184 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2185 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2188 C Derivatives in DC(i)
2189 ghalf1=0.5d0*agg(k,1)
2190 ghalf2=0.5d0*agg(k,2)
2191 ghalf3=0.5d0*agg(k,3)
2192 ghalf4=0.5d0*agg(k,4)
2193 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2194 & -3.0d0*uryg(k,2)*vry)+ghalf1
2195 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2196 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2197 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2198 & -3.0d0*urzg(k,2)*vry)+ghalf3
2199 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2200 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2201 C Derivatives in DC(i+1)
2202 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2203 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2204 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2205 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2206 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2207 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2208 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2209 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2210 C Derivatives in DC(j)
2211 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2212 & -3.0d0*vryg(k,2)*ury)+ghalf1
2213 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2214 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2215 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2216 & -3.0d0*vryg(k,2)*urz)+ghalf3
2217 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2218 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2219 C Derivatives in DC(j+1) or DC(nres-1)
2220 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2221 & -3.0d0*vryg(k,3)*ury)
2222 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2223 & -3.0d0*vrzg(k,3)*ury)
2224 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2225 & -3.0d0*vryg(k,3)*urz)
2226 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2227 & -3.0d0*vrzg(k,3)*urz)
2232 C Derivatives in DC(i+1)
2233 cd aggi1(k,1)=agg(k,1)
2234 cd aggi1(k,2)=agg(k,2)
2235 cd aggi1(k,3)=agg(k,3)
2236 cd aggi1(k,4)=agg(k,4)
2237 C Derivatives in DC(j)
2242 C Derivatives in DC(j+1)
2247 if (j.eq.nres-1 .and. i.lt.j-2) then
2249 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2250 cd aggj1(k,l)=agg(k,l)
2256 C Check the loc-el terms by numerical integration
2266 aggi(k,l)=-aggi(k,l)
2267 aggi1(k,l)=-aggi1(k,l)
2268 aggj(k,l)=-aggj(k,l)
2269 aggj1(k,l)=-aggj1(k,l)
2272 if (j.lt.nres-1) then
2278 aggi(k,l)=-aggi(k,l)
2279 aggi1(k,l)=-aggi1(k,l)
2280 aggj(k,l)=-aggj(k,l)
2281 aggj1(k,l)=-aggj1(k,l)
2292 aggi(k,l)=-aggi(k,l)
2293 aggi1(k,l)=-aggi1(k,l)
2294 aggj(k,l)=-aggj(k,l)
2295 aggj1(k,l)=-aggj1(k,l)
2301 IF (wel_loc.gt.0.0d0) THEN
2302 C Contribution to the local-electrostatic energy coming from the i-j pair
2303 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2305 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2306 c write (iout,'(a6,2i5,0pf7.3)')
2307 c & 'eelloc',i,j,eel_loc_ij
2308 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2309 eel_loc=eel_loc+eel_loc_ij
2310 C Partial derivatives in virtual-bond dihedral angles gamma
2313 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2314 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2315 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2316 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2317 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2318 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2319 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2320 cd write(iout,*) 'agg ',agg
2321 cd write(iout,*) 'aggi ',aggi
2322 cd write(iout,*) 'aggi1',aggi1
2323 cd write(iout,*) 'aggj ',aggj
2324 cd write(iout,*) 'aggj1',aggj1
2326 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2328 ggg(l)=agg(l,1)*muij(1)+
2329 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2333 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2336 C Remaining derivatives of eello
2338 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2339 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2340 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2341 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2342 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2343 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2344 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2345 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2349 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2350 C Contributions from turns
2355 call eturn34(i,j,eello_turn3,eello_turn4)
2357 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2358 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2360 C Calculate the contact function. The ith column of the array JCONT will
2361 C contain the numbers of atoms that make contacts with the atom I (of numbers
2362 C greater than I). The arrays FACONT and GACONT will contain the values of
2363 C the contact function and its derivative.
2364 c r0ij=1.02D0*rpp(iteli,itelj)
2365 c r0ij=1.11D0*rpp(iteli,itelj)
2366 r0ij=2.20D0*rpp(iteli,itelj)
2367 c r0ij=1.55D0*rpp(iteli,itelj)
2368 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2369 if (fcont.gt.0.0D0) then
2370 num_conti=num_conti+1
2371 if (num_conti.gt.maxconts) then
2372 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2373 & ' will skip next contacts for this conf.'
2375 jcont_hb(num_conti,i)=j
2376 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2377 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2378 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2380 d_cont(num_conti,i)=rij
2381 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2382 C --- Electrostatic-interaction matrix ---
2383 a_chuj(1,1,num_conti,i)=a22
2384 a_chuj(1,2,num_conti,i)=a23
2385 a_chuj(2,1,num_conti,i)=a32
2386 a_chuj(2,2,num_conti,i)=a33
2387 C --- Gradient of rij
2389 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2392 c a_chuj(1,1,num_conti,i)=-0.61d0
2393 c a_chuj(1,2,num_conti,i)= 0.4d0
2394 c a_chuj(2,1,num_conti,i)= 0.65d0
2395 c a_chuj(2,2,num_conti,i)= 0.50d0
2396 c else if (i.eq.2) then
2397 c a_chuj(1,1,num_conti,i)= 0.0d0
2398 c a_chuj(1,2,num_conti,i)= 0.0d0
2399 c a_chuj(2,1,num_conti,i)= 0.0d0
2400 c a_chuj(2,2,num_conti,i)= 0.0d0
2402 C --- and its gradients
2403 cd write (iout,*) 'i',i,' j',j
2405 cd write (iout,*) 'iii 1 kkk',kkk
2406 cd write (iout,*) agg(kkk,:)
2409 cd write (iout,*) 'iii 2 kkk',kkk
2410 cd write (iout,*) aggi(kkk,:)
2413 cd write (iout,*) 'iii 3 kkk',kkk
2414 cd write (iout,*) aggi1(kkk,:)
2417 cd write (iout,*) 'iii 4 kkk',kkk
2418 cd write (iout,*) aggj(kkk,:)
2421 cd write (iout,*) 'iii 5 kkk',kkk
2422 cd write (iout,*) aggj1(kkk,:)
2429 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2430 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2431 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2432 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2433 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2435 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2441 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2442 C Calculate contact energies
2444 wij=cosa-3.0D0*cosb*cosg
2447 c fac3=dsqrt(-ael6i)/r0ij**3
2448 fac3=dsqrt(-ael6i)*r3ij
2449 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2450 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2452 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2453 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2454 C Diagnostics. Comment out or remove after debugging!
2455 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2456 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2457 c ees0m(num_conti,i)=0.0D0
2459 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2460 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2461 facont_hb(num_conti,i)=fcont
2463 C Angular derivatives of the contact function
2464 ees0pij1=fac3/ees0pij
2465 ees0mij1=fac3/ees0mij
2466 fac3p=-3.0D0*fac3*rrmij
2467 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2468 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2470 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2471 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2472 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2473 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2474 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2475 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2476 ecosap=ecosa1+ecosa2
2477 ecosbp=ecosb1+ecosb2
2478 ecosgp=ecosg1+ecosg2
2479 ecosam=ecosa1-ecosa2
2480 ecosbm=ecosb1-ecosb2
2481 ecosgm=ecosg1-ecosg2
2490 fprimcont=fprimcont/rij
2491 cd facont_hb(num_conti,i)=1.0D0
2492 C Following line is for diagnostics.
2495 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2496 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2499 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2500 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2502 gggp(1)=gggp(1)+ees0pijp*xj
2503 gggp(2)=gggp(2)+ees0pijp*yj
2504 gggp(3)=gggp(3)+ees0pijp*zj
2505 gggm(1)=gggm(1)+ees0mijp*xj
2506 gggm(2)=gggm(2)+ees0mijp*yj
2507 gggm(3)=gggm(3)+ees0mijp*zj
2508 C Derivatives due to the contact function
2509 gacont_hbr(1,num_conti,i)=fprimcont*xj
2510 gacont_hbr(2,num_conti,i)=fprimcont*yj
2511 gacont_hbr(3,num_conti,i)=fprimcont*zj
2513 ghalfp=0.5D0*gggp(k)
2514 ghalfm=0.5D0*gggm(k)
2515 gacontp_hb1(k,num_conti,i)=ghalfp
2516 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2517 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2518 gacontp_hb2(k,num_conti,i)=ghalfp
2519 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2520 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2521 gacontp_hb3(k,num_conti,i)=gggp(k)
2522 gacontm_hb1(k,num_conti,i)=ghalfm
2523 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2524 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2525 gacontm_hb2(k,num_conti,i)=ghalfm
2526 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2527 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2528 gacontm_hb3(k,num_conti,i)=gggm(k)
2531 C Diagnostics. Comment out or remove after debugging!
2533 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2534 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2535 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2536 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2537 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2538 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2541 endif ! num_conti.le.maxconts
2546 num_cont_hb(i)=num_conti
2550 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2551 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2553 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2554 ccc eel_loc=eel_loc+eello_turn3
2557 C-----------------------------------------------------------------------------
2558 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2559 C Third- and fourth-order contributions from turns
2560 implicit real*8 (a-h,o-z)
2561 include 'DIMENSIONS'
2562 include 'DIMENSIONS.ZSCOPT'
2563 include 'COMMON.IOUNITS'
2564 include 'COMMON.GEO'
2565 include 'COMMON.VAR'
2566 include 'COMMON.LOCAL'
2567 include 'COMMON.CHAIN'
2568 include 'COMMON.DERIV'
2569 include 'COMMON.INTERACT'
2570 include 'COMMON.CONTACTS'
2571 include 'COMMON.TORSION'
2572 include 'COMMON.VECTORS'
2573 include 'COMMON.FFIELD'
2575 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2576 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2577 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2578 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2579 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2580 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2582 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2584 C Third-order contributions
2591 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2592 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2593 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2594 call transpose2(auxmat(1,1),auxmat1(1,1))
2595 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2596 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2597 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2598 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2599 cd & ' eello_turn3_num',4*eello_turn3_num
2601 C Derivatives in gamma(i)
2602 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2603 call transpose2(auxmat2(1,1),pizda(1,1))
2604 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2605 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2606 C Derivatives in gamma(i+1)
2607 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2608 call transpose2(auxmat2(1,1),pizda(1,1))
2609 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2610 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2611 & +0.5d0*(pizda(1,1)+pizda(2,2))
2612 C Cartesian derivatives
2614 a_temp(1,1)=aggi(l,1)
2615 a_temp(1,2)=aggi(l,2)
2616 a_temp(2,1)=aggi(l,3)
2617 a_temp(2,2)=aggi(l,4)
2618 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2619 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2620 & +0.5d0*(pizda(1,1)+pizda(2,2))
2621 a_temp(1,1)=aggi1(l,1)
2622 a_temp(1,2)=aggi1(l,2)
2623 a_temp(2,1)=aggi1(l,3)
2624 a_temp(2,2)=aggi1(l,4)
2625 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2626 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2627 & +0.5d0*(pizda(1,1)+pizda(2,2))
2628 a_temp(1,1)=aggj(l,1)
2629 a_temp(1,2)=aggj(l,2)
2630 a_temp(2,1)=aggj(l,3)
2631 a_temp(2,2)=aggj(l,4)
2632 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2633 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2634 & +0.5d0*(pizda(1,1)+pizda(2,2))
2635 a_temp(1,1)=aggj1(l,1)
2636 a_temp(1,2)=aggj1(l,2)
2637 a_temp(2,1)=aggj1(l,3)
2638 a_temp(2,2)=aggj1(l,4)
2639 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2640 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2641 & +0.5d0*(pizda(1,1)+pizda(2,2))
2644 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2645 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2647 C Fourth-order contributions
2655 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2656 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2657 iti1=itortyp(itype(i+1))
2658 iti2=itortyp(itype(i+2))
2659 iti3=itortyp(itype(i+3))
2660 call transpose2(EUg(1,1,i+1),e1t(1,1))
2661 call transpose2(Eug(1,1,i+2),e2t(1,1))
2662 call transpose2(Eug(1,1,i+3),e3t(1,1))
2663 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2664 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2665 s1=scalar2(b1(1,iti2),auxvec(1))
2666 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2667 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2668 s2=scalar2(b1(1,iti1),auxvec(1))
2669 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2670 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2671 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2672 eello_turn4=eello_turn4-(s1+s2+s3)
2673 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2674 cd & ' eello_turn4_num',8*eello_turn4_num
2675 C Derivatives in gamma(i)
2677 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2678 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2679 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2680 s1=scalar2(b1(1,iti2),auxvec(1))
2681 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2682 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2683 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2684 C Derivatives in gamma(i+1)
2685 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2686 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2687 s2=scalar2(b1(1,iti1),auxvec(1))
2688 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2689 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2690 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2691 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2692 C Derivatives in gamma(i+2)
2693 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2694 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2695 s1=scalar2(b1(1,iti2),auxvec(1))
2696 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2697 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2698 s2=scalar2(b1(1,iti1),auxvec(1))
2699 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2700 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2701 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2702 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2703 C Cartesian derivatives
2704 C Derivatives of this turn contributions in DC(i+2)
2705 if (j.lt.nres-1) then
2707 a_temp(1,1)=agg(l,1)
2708 a_temp(1,2)=agg(l,2)
2709 a_temp(2,1)=agg(l,3)
2710 a_temp(2,2)=agg(l,4)
2711 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2712 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2713 s1=scalar2(b1(1,iti2),auxvec(1))
2714 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2715 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2716 s2=scalar2(b1(1,iti1),auxvec(1))
2717 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2718 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2719 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2721 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2724 C Remaining derivatives of this turn contribution
2726 a_temp(1,1)=aggi(l,1)
2727 a_temp(1,2)=aggi(l,2)
2728 a_temp(2,1)=aggi(l,3)
2729 a_temp(2,2)=aggi(l,4)
2730 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2731 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2732 s1=scalar2(b1(1,iti2),auxvec(1))
2733 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2734 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2735 s2=scalar2(b1(1,iti1),auxvec(1))
2736 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2737 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2738 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2739 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2740 a_temp(1,1)=aggi1(l,1)
2741 a_temp(1,2)=aggi1(l,2)
2742 a_temp(2,1)=aggi1(l,3)
2743 a_temp(2,2)=aggi1(l,4)
2744 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2745 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2746 s1=scalar2(b1(1,iti2),auxvec(1))
2747 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2748 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2749 s2=scalar2(b1(1,iti1),auxvec(1))
2750 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2751 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2752 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2753 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2754 a_temp(1,1)=aggj(l,1)
2755 a_temp(1,2)=aggj(l,2)
2756 a_temp(2,1)=aggj(l,3)
2757 a_temp(2,2)=aggj(l,4)
2758 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2759 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2760 s1=scalar2(b1(1,iti2),auxvec(1))
2761 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2762 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2763 s2=scalar2(b1(1,iti1),auxvec(1))
2764 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2765 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2766 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2767 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2768 a_temp(1,1)=aggj1(l,1)
2769 a_temp(1,2)=aggj1(l,2)
2770 a_temp(2,1)=aggj1(l,3)
2771 a_temp(2,2)=aggj1(l,4)
2772 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2773 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2774 s1=scalar2(b1(1,iti2),auxvec(1))
2775 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2776 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2777 s2=scalar2(b1(1,iti1),auxvec(1))
2778 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2779 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2780 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2781 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2787 C-----------------------------------------------------------------------------
2788 subroutine vecpr(u,v,w)
2789 implicit real*8(a-h,o-z)
2790 dimension u(3),v(3),w(3)
2791 w(1)=u(2)*v(3)-u(3)*v(2)
2792 w(2)=-u(1)*v(3)+u(3)*v(1)
2793 w(3)=u(1)*v(2)-u(2)*v(1)
2796 C-----------------------------------------------------------------------------
2797 subroutine unormderiv(u,ugrad,unorm,ungrad)
2798 C This subroutine computes the derivatives of a normalized vector u, given
2799 C the derivatives computed without normalization conditions, ugrad. Returns
2802 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2803 double precision vec(3)
2804 double precision scalar
2806 c write (2,*) 'ugrad',ugrad
2809 vec(i)=scalar(ugrad(1,i),u(1))
2811 c write (2,*) 'vec',vec
2814 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2817 c write (2,*) 'ungrad',ungrad
2820 C-----------------------------------------------------------------------------
2821 subroutine escp(evdw2,evdw2_14)
2823 C This subroutine calculates the excluded-volume interaction energy between
2824 C peptide-group centers and side chains and its gradient in virtual-bond and
2825 C side-chain vectors.
2827 implicit real*8 (a-h,o-z)
2828 include 'DIMENSIONS'
2829 include 'DIMENSIONS.ZSCOPT'
2830 include 'COMMON.GEO'
2831 include 'COMMON.VAR'
2832 include 'COMMON.LOCAL'
2833 include 'COMMON.CHAIN'
2834 include 'COMMON.DERIV'
2835 include 'COMMON.INTERACT'
2836 include 'COMMON.FFIELD'
2837 include 'COMMON.IOUNITS'
2841 cd print '(a)','Enter ESCP'
2842 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2843 c & ' scal14',scal14
2844 do i=iatscp_s,iatscp_e
2845 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2847 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2848 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2849 if (iteli.eq.0) goto 1225
2850 xi=0.5D0*(c(1,i)+c(1,i+1))
2851 yi=0.5D0*(c(2,i)+c(2,i+1))
2852 zi=0.5D0*(c(3,i)+c(3,i+1))
2854 do iint=1,nscp_gr(i)
2856 do j=iscpstart(i,iint),iscpend(i,iint)
2857 itypj=iabs(itype(j))
2858 if (itypj.eq.ntyp1) cycle
2859 C Uncomment following three lines for SC-p interactions
2863 C Uncomment following three lines for Ca-p interactions
2867 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2869 e1=fac*fac*aad(itypj,iteli)
2870 e2=fac*bad(itypj,iteli)
2871 if (iabs(j-i) .le. 2) then
2874 evdw2_14=evdw2_14+e1+e2
2877 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
2878 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
2879 c & bad(itypj,iteli)
2883 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2885 fac=-(evdwij+e1)*rrij
2890 cd write (iout,*) 'j<i'
2891 C Uncomment following three lines for SC-p interactions
2893 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2896 cd write (iout,*) 'j>i'
2899 C Uncomment following line for SC-p interactions
2900 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2904 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2908 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2909 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2912 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2922 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2923 gradx_scp(j,i)=expon*gradx_scp(j,i)
2926 C******************************************************************************
2930 C To save time the factor EXPON has been extracted from ALL components
2931 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2934 C******************************************************************************
2937 C--------------------------------------------------------------------------
2938 subroutine edis(ehpb)
2940 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2942 implicit real*8 (a-h,o-z)
2943 include 'DIMENSIONS'
2944 include 'DIMENSIONS.ZSCOPT'
2945 include 'COMMON.SBRIDGE'
2946 include 'COMMON.CHAIN'
2947 include 'COMMON.DERIV'
2948 include 'COMMON.VAR'
2949 include 'COMMON.INTERACT'
2952 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2953 cd print *,'link_start=',link_start,' link_end=',link_end
2954 if (link_end.eq.0) return
2955 do i=link_start,link_end
2956 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2957 C CA-CA distance used in regularization of structure.
2960 C iii and jjj point to the residues for which the distance is assigned.
2961 if (ii.gt.nres) then
2968 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2969 C distance and angle dependent SS bond potential.
2970 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2971 C & iabs(itype(jjj)).eq.1) then
2973 if (.not.dyn_ss .and. i.le.nss) then
2974 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2975 & iabs(itype(jjj)).eq.1) then
2976 call ssbond_ene(iii,jjj,eij)
2979 else if (ii.gt.nres .and. jj.gt.nres) then
2980 c Restraints from contact prediction
2982 if (constr_dist.eq.11) then
2983 ehpb=ehpb+fordepth(i)**4.0d0
2984 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
2985 fac=fordepth(i)**4.0d0
2986 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
2988 if (dhpb1(i).gt.0.0d0) then
2989 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2990 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
2991 c write (iout,*) "beta nmr",
2992 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
2996 C Get the force constant corresponding to this distance.
2998 C Calculate the contribution to energy.
2999 ehpb=ehpb+waga*rdis*rdis
3000 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3002 C Evaluate gradient.
3008 ggg(j)=fac*(c(j,jj)-c(j,ii))
3011 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3012 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3015 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3016 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3020 C Get the force constant corresponding to this distance.
3022 C Calculate the contribution to energy.
3023 ehpb=ehpb+waga*rdis*rdis
3024 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3026 C Evaluate gradient.
3033 ggg(j)=fac*(c(j,jj)-c(j,ii))
3035 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3036 C If this is a SC-SC distance, we need to calculate the contributions to the
3037 C Cartesian gradient in the SC vectors (ghpbx).
3040 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3041 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3046 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3051 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
3054 C--------------------------------------------------------------------------
3055 subroutine ssbond_ene(i,j,eij)
3057 C Calculate the distance and angle dependent SS-bond potential energy
3058 C using a free-energy function derived based on RHF/6-31G** ab initio
3059 C calculations of diethyl disulfide.
3061 C A. Liwo and U. Kozlowska, 11/24/03
3063 implicit real*8 (a-h,o-z)
3064 include 'DIMENSIONS'
3065 include 'DIMENSIONS.ZSCOPT'
3066 include 'COMMON.SBRIDGE'
3067 include 'COMMON.CHAIN'
3068 include 'COMMON.DERIV'
3069 include 'COMMON.LOCAL'
3070 include 'COMMON.INTERACT'
3071 include 'COMMON.VAR'
3072 include 'COMMON.IOUNITS'
3073 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3074 itypi=iabs(itype(i))
3078 dxi=dc_norm(1,nres+i)
3079 dyi=dc_norm(2,nres+i)
3080 dzi=dc_norm(3,nres+i)
3081 dsci_inv=dsc_inv(itypi)
3082 itypj=iabs(itype(j))
3083 dscj_inv=dsc_inv(itypj)
3087 dxj=dc_norm(1,nres+j)
3088 dyj=dc_norm(2,nres+j)
3089 dzj=dc_norm(3,nres+j)
3090 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3095 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3096 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3097 om12=dxi*dxj+dyi*dyj+dzi*dzj
3099 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3100 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3106 deltat12=om2-om1+2.0d0
3108 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3109 & +akct*deltad*deltat12
3110 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3111 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3112 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3113 c & " deltat12",deltat12," eij",eij
3114 ed=2*akcm*deltad+akct*deltat12
3116 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3117 eom1=-2*akth*deltat1-pom1-om2*pom2
3118 eom2= 2*akth*deltat2+pom1-om1*pom2
3121 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3124 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3125 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3126 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3127 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3130 C Calculate the components of the gradient in DC and X
3134 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3139 C--------------------------------------------------------------------------
3140 subroutine ebond(estr)
3142 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3144 implicit real*8 (a-h,o-z)
3145 include 'DIMENSIONS'
3146 include 'DIMENSIONS.ZSCOPT'
3147 include 'COMMON.LOCAL'
3148 include 'COMMON.GEO'
3149 include 'COMMON.INTERACT'
3150 include 'COMMON.DERIV'
3151 include 'COMMON.VAR'
3152 include 'COMMON.CHAIN'
3153 include 'COMMON.IOUNITS'
3154 include 'COMMON.NAMES'
3155 include 'COMMON.FFIELD'
3156 include 'COMMON.CONTROL'
3157 logical energy_dec /.false./
3158 double precision u(3),ud(3)
3161 c write (iout,*) "distchainmax",distchainmax
3163 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3164 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3166 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3167 & *dc(j,i-1)/vbld(i)
3169 if (energy_dec) write(iout,*)
3170 & "estr1",i,vbld(i),distchainmax,
3171 & gnmr1(vbld(i),-1.0d0,distchainmax)
3173 diff = vbld(i)-vbldp0
3174 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3177 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3182 estr=0.5d0*AKP*estr+estr1
3184 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3188 if (iti.ne.10 .and. iti.ne.ntyp1) then
3191 diff=vbld(i+nres)-vbldsc0(1,iti)
3192 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3193 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3194 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3196 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3200 diff=vbld(i+nres)-vbldsc0(j,iti)
3201 ud(j)=aksc(j,iti)*diff
3202 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3216 uprod2=uprod2*u(k)*u(k)
3220 usumsqder=usumsqder+ud(j)*uprod2
3222 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3223 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3224 estr=estr+uprod/usum
3226 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3234 C--------------------------------------------------------------------------
3235 subroutine ebend(etheta)
3237 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3238 C angles gamma and its derivatives in consecutive thetas and gammas.
3240 implicit real*8 (a-h,o-z)
3241 include 'DIMENSIONS'
3242 include 'DIMENSIONS.ZSCOPT'
3243 include 'COMMON.LOCAL'
3244 include 'COMMON.GEO'
3245 include 'COMMON.INTERACT'
3246 include 'COMMON.DERIV'
3247 include 'COMMON.VAR'
3248 include 'COMMON.CHAIN'
3249 include 'COMMON.IOUNITS'
3250 include 'COMMON.NAMES'
3251 include 'COMMON.FFIELD'
3252 common /calcthet/ term1,term2,termm,diffak,ratak,
3253 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3254 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3255 double precision y(2),z(2)
3257 c time11=dexp(-2*time)
3260 c write (iout,*) "nres",nres
3261 c write (*,'(a,i2)') 'EBEND ICG=',icg
3262 c write (iout,*) ithet_start,ithet_end
3263 do i=ithet_start,ithet_end
3264 if (itype(i-1).eq.ntyp1) cycle
3265 C Zero the energy function and its derivative at 0 or pi.
3266 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3268 ichir1=isign(1,itype(i-2))
3269 ichir2=isign(1,itype(i))
3270 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3271 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3272 if (itype(i-1).eq.10) then
3273 itype1=isign(10,itype(i-2))
3274 ichir11=isign(1,itype(i-2))
3275 ichir12=isign(1,itype(i-2))
3276 itype2=isign(10,itype(i))
3277 ichir21=isign(1,itype(i))
3278 ichir22=isign(1,itype(i))
3281 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3285 c call proc_proc(phii,icrc)
3286 if (icrc.eq.1) phii=150.0
3296 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3300 c call proc_proc(phii1,icrc)
3301 if (icrc.eq.1) phii1=150.0
3313 C Calculate the "mean" value of theta from the part of the distribution
3314 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3315 C In following comments this theta will be referred to as t_c.
3316 thet_pred_mean=0.0d0
3318 athetk=athet(k,it,ichir1,ichir2)
3319 bthetk=bthet(k,it,ichir1,ichir2)
3321 athetk=athet(k,itype1,ichir11,ichir12)
3322 bthetk=bthet(k,itype2,ichir21,ichir22)
3324 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3326 c write (iout,*) "thet_pred_mean",thet_pred_mean
3327 dthett=thet_pred_mean*ssd
3328 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3329 c write (iout,*) "thet_pred_mean",thet_pred_mean
3330 C Derivatives of the "mean" values in gamma1 and gamma2.
3331 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3332 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3333 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3334 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3336 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3337 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3338 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3339 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3341 if (theta(i).gt.pi-delta) then
3342 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3344 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3345 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3346 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3348 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3350 else if (theta(i).lt.delta) then
3351 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3352 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3353 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3355 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3356 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3359 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3362 etheta=etheta+ethetai
3363 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3364 c & rad2deg*phii,rad2deg*phii1,ethetai
3365 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3366 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3367 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3370 C Ufff.... We've done all this!!!
3373 C---------------------------------------------------------------------------
3374 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3376 implicit real*8 (a-h,o-z)
3377 include 'DIMENSIONS'
3378 include 'COMMON.LOCAL'
3379 include 'COMMON.IOUNITS'
3380 common /calcthet/ term1,term2,termm,diffak,ratak,
3381 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3382 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3383 C Calculate the contributions to both Gaussian lobes.
3384 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3385 C The "polynomial part" of the "standard deviation" of this part of
3389 sig=sig*thet_pred_mean+polthet(j,it)
3391 C Derivative of the "interior part" of the "standard deviation of the"
3392 C gamma-dependent Gaussian lobe in t_c.
3393 sigtc=3*polthet(3,it)
3395 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3398 C Set the parameters of both Gaussian lobes of the distribution.
3399 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3400 fac=sig*sig+sigc0(it)
3403 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3404 sigsqtc=-4.0D0*sigcsq*sigtc
3405 c print *,i,sig,sigtc,sigsqtc
3406 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3407 sigtc=-sigtc/(fac*fac)
3408 C Following variable is sigma(t_c)**(-2)
3409 sigcsq=sigcsq*sigcsq
3411 sig0inv=1.0D0/sig0i**2
3412 delthec=thetai-thet_pred_mean
3413 delthe0=thetai-theta0i
3414 term1=-0.5D0*sigcsq*delthec*delthec
3415 term2=-0.5D0*sig0inv*delthe0*delthe0
3416 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3417 C NaNs in taking the logarithm. We extract the largest exponent which is added
3418 C to the energy (this being the log of the distribution) at the end of energy
3419 C term evaluation for this virtual-bond angle.
3420 if (term1.gt.term2) then
3422 term2=dexp(term2-termm)
3426 term1=dexp(term1-termm)
3429 C The ratio between the gamma-independent and gamma-dependent lobes of
3430 C the distribution is a Gaussian function of thet_pred_mean too.
3431 diffak=gthet(2,it)-thet_pred_mean
3432 ratak=diffak/gthet(3,it)**2
3433 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3434 C Let's differentiate it in thet_pred_mean NOW.
3436 C Now put together the distribution terms to make complete distribution.
3437 termexp=term1+ak*term2
3438 termpre=sigc+ak*sig0i
3439 C Contribution of the bending energy from this theta is just the -log of
3440 C the sum of the contributions from the two lobes and the pre-exponential
3441 C factor. Simple enough, isn't it?
3442 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3443 C NOW the derivatives!!!
3444 C 6/6/97 Take into account the deformation.
3445 E_theta=(delthec*sigcsq*term1
3446 & +ak*delthe0*sig0inv*term2)/termexp
3447 E_tc=((sigtc+aktc*sig0i)/termpre
3448 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3449 & aktc*term2)/termexp)
3452 c-----------------------------------------------------------------------------
3453 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3454 implicit real*8 (a-h,o-z)
3455 include 'DIMENSIONS'
3456 include 'COMMON.LOCAL'
3457 include 'COMMON.IOUNITS'
3458 common /calcthet/ term1,term2,termm,diffak,ratak,
3459 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3460 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3461 delthec=thetai-thet_pred_mean
3462 delthe0=thetai-theta0i
3463 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3464 t3 = thetai-thet_pred_mean
3468 t14 = t12+t6*sigsqtc
3470 t21 = thetai-theta0i
3476 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3477 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3478 & *(-t12*t9-ak*sig0inv*t27)
3482 C--------------------------------------------------------------------------
3483 subroutine ebend(etheta)
3485 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3486 C angles gamma and its derivatives in consecutive thetas and gammas.
3487 C ab initio-derived potentials from
3488 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3490 implicit real*8 (a-h,o-z)
3491 include 'DIMENSIONS'
3492 include 'DIMENSIONS.ZSCOPT'
3493 include 'COMMON.LOCAL'
3494 include 'COMMON.GEO'
3495 include 'COMMON.INTERACT'
3496 include 'COMMON.DERIV'
3497 include 'COMMON.VAR'
3498 include 'COMMON.CHAIN'
3499 include 'COMMON.IOUNITS'
3500 include 'COMMON.NAMES'
3501 include 'COMMON.FFIELD'
3502 include 'COMMON.CONTROL'
3503 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3504 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3505 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3506 & sinph1ph2(maxdouble,maxdouble)
3507 logical lprn /.false./, lprn1 /.false./
3509 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3510 do i=ithet_start,ithet_end
3511 c if (itype(i-1).eq.ntyp1) cycle
3512 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3513 &(itype(i).eq.ntyp1)) cycle
3514 if (iabs(itype(i+1)).eq.20) iblock=2
3515 if (iabs(itype(i+1)).ne.20) iblock=1
3519 theti2=0.5d0*theta(i)
3520 ityp2=ithetyp((itype(i-1)))
3522 coskt(k)=dcos(k*theti2)
3523 sinkt(k)=dsin(k*theti2)
3525 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3528 if (phii.ne.phii) phii=150.0
3532 ityp1=ithetyp((itype(i-2)))
3534 cosph1(k)=dcos(k*phii)
3535 sinph1(k)=dsin(k*phii)
3541 ityp1=ithetyp((itype(i-2)))
3546 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3549 if (phii1.ne.phii1) phii1=150.0
3554 ityp3=ithetyp((itype(i)))
3556 cosph2(k)=dcos(k*phii1)
3557 sinph2(k)=dsin(k*phii1)
3562 ityp3=ithetyp((itype(i)))
3568 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3569 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3571 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3574 ccl=cosph1(l)*cosph2(k-l)
3575 ssl=sinph1(l)*sinph2(k-l)
3576 scl=sinph1(l)*cosph2(k-l)
3577 csl=cosph1(l)*sinph2(k-l)
3578 cosph1ph2(l,k)=ccl-ssl
3579 cosph1ph2(k,l)=ccl+ssl
3580 sinph1ph2(l,k)=scl+csl
3581 sinph1ph2(k,l)=scl-csl
3585 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3586 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3587 write (iout,*) "coskt and sinkt"
3589 write (iout,*) k,coskt(k),sinkt(k)
3593 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3594 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3597 & write (iout,*) "k",k,"
3598 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3599 & " ethetai",ethetai
3602 write (iout,*) "cosph and sinph"
3604 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3606 write (iout,*) "cosph1ph2 and sinph2ph2"
3609 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3610 & sinph1ph2(l,k),sinph1ph2(k,l)
3613 write(iout,*) "ethetai",ethetai
3617 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3618 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3619 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3620 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3621 ethetai=ethetai+sinkt(m)*aux
3622 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3623 dephii=dephii+k*sinkt(m)*(
3624 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3625 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3626 dephii1=dephii1+k*sinkt(m)*(
3627 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3628 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3630 & write (iout,*) "m",m," k",k," bbthet",
3631 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3632 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3633 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3634 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3638 & write(iout,*) "ethetai",ethetai
3642 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3643 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3644 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3645 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3646 ethetai=ethetai+sinkt(m)*aux
3647 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3648 dephii=dephii+l*sinkt(m)*(
3649 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3650 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3651 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3652 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3653 dephii1=dephii1+(k-l)*sinkt(m)*(
3654 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3655 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3656 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3657 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3659 write (iout,*) "m",m," k",k," l",l," ffthet",
3660 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3661 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3662 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3663 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3664 & " ethetai",ethetai
3665 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3666 & cosph1ph2(k,l)*sinkt(m),
3667 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3673 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3674 & i,theta(i)*rad2deg,phii*rad2deg,
3675 & phii1*rad2deg,ethetai
3676 etheta=etheta+ethetai
3677 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3678 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3679 c gloc(nphi+i-2,icg)=wang*dethetai
3680 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3686 c-----------------------------------------------------------------------------
3687 subroutine esc(escloc)
3688 C Calculate the local energy of a side chain and its derivatives in the
3689 C corresponding virtual-bond valence angles THETA and the spherical angles
3691 implicit real*8 (a-h,o-z)
3692 include 'DIMENSIONS'
3693 include 'DIMENSIONS.ZSCOPT'
3694 include 'COMMON.GEO'
3695 include 'COMMON.LOCAL'
3696 include 'COMMON.VAR'
3697 include 'COMMON.INTERACT'
3698 include 'COMMON.DERIV'
3699 include 'COMMON.CHAIN'
3700 include 'COMMON.IOUNITS'
3701 include 'COMMON.NAMES'
3702 include 'COMMON.FFIELD'
3703 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3704 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3705 common /sccalc/ time11,time12,time112,theti,it,nlobit
3708 c write (iout,'(a)') 'ESC'
3709 do i=loc_start,loc_end
3711 if (it.eq.ntyp1) cycle
3712 if (it.eq.10) goto 1
3713 nlobit=nlob(iabs(it))
3714 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3715 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3716 theti=theta(i+1)-pipol
3720 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3722 if (x(2).gt.pi-delta) then
3726 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3728 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3729 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3731 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3732 & ddersc0(1),dersc(1))
3733 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3734 & ddersc0(3),dersc(3))
3736 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3738 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3739 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3740 & dersc0(2),esclocbi,dersc02)
3741 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3743 call splinthet(x(2),0.5d0*delta,ss,ssd)
3748 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3750 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3751 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3753 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3755 c write (iout,*) escloci
3756 else if (x(2).lt.delta) then
3760 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3762 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3763 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3765 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3766 & ddersc0(1),dersc(1))
3767 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3768 & ddersc0(3),dersc(3))
3770 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3772 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3773 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3774 & dersc0(2),esclocbi,dersc02)
3775 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3780 call splinthet(x(2),0.5d0*delta,ss,ssd)
3782 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3784 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3785 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3787 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3788 c write (iout,*) escloci
3790 call enesc(x,escloci,dersc,ddummy,.false.)
3793 escloc=escloc+escloci
3794 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3796 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3798 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3799 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3804 C---------------------------------------------------------------------------
3805 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3806 implicit real*8 (a-h,o-z)
3807 include 'DIMENSIONS'
3808 include 'COMMON.GEO'
3809 include 'COMMON.LOCAL'
3810 include 'COMMON.IOUNITS'
3811 common /sccalc/ time11,time12,time112,theti,it,nlobit
3812 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3813 double precision contr(maxlob,-1:1)
3815 c write (iout,*) 'it=',it,' nlobit=',nlobit
3819 if (mixed) ddersc(j)=0.0d0
3823 C Because of periodicity of the dependence of the SC energy in omega we have
3824 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3825 C To avoid underflows, first compute & store the exponents.
3833 z(k)=x(k)-censc(k,j,it)
3838 Axk=Axk+gaussc(l,k,j,it)*z(l)
3844 expfac=expfac+Ax(k,j,iii)*z(k)
3852 C As in the case of ebend, we want to avoid underflows in exponentiation and
3853 C subsequent NaNs and INFs in energy calculation.
3854 C Find the largest exponent
3858 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3862 cd print *,'it=',it,' emin=',emin
3864 C Compute the contribution to SC energy and derivatives
3868 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3869 cd print *,'j=',j,' expfac=',expfac
3870 escloc_i=escloc_i+expfac
3872 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3876 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3877 & +gaussc(k,2,j,it))*expfac
3884 dersc(1)=dersc(1)/cos(theti)**2
3885 ddersc(1)=ddersc(1)/cos(theti)**2
3888 escloci=-(dlog(escloc_i)-emin)
3890 dersc(j)=dersc(j)/escloc_i
3894 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3899 C------------------------------------------------------------------------------
3900 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3901 implicit real*8 (a-h,o-z)
3902 include 'DIMENSIONS'
3903 include 'COMMON.GEO'
3904 include 'COMMON.LOCAL'
3905 include 'COMMON.IOUNITS'
3906 common /sccalc/ time11,time12,time112,theti,it,nlobit
3907 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3908 double precision contr(maxlob)
3919 z(k)=x(k)-censc(k,j,it)
3925 Axk=Axk+gaussc(l,k,j,it)*z(l)
3931 expfac=expfac+Ax(k,j)*z(k)
3936 C As in the case of ebend, we want to avoid underflows in exponentiation and
3937 C subsequent NaNs and INFs in energy calculation.
3938 C Find the largest exponent
3941 if (emin.gt.contr(j)) emin=contr(j)
3945 C Compute the contribution to SC energy and derivatives
3949 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3950 escloc_i=escloc_i+expfac
3952 dersc(k)=dersc(k)+Ax(k,j)*expfac
3954 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3955 & +gaussc(1,2,j,it))*expfac
3959 dersc(1)=dersc(1)/cos(theti)**2
3960 dersc12=dersc12/cos(theti)**2
3961 escloci=-(dlog(escloc_i)-emin)
3963 dersc(j)=dersc(j)/escloc_i
3965 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3969 c----------------------------------------------------------------------------------
3970 subroutine esc(escloc)
3971 C Calculate the local energy of a side chain and its derivatives in the
3972 C corresponding virtual-bond valence angles THETA and the spherical angles
3973 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3974 C added by Urszula Kozlowska. 07/11/2007
3976 implicit real*8 (a-h,o-z)
3977 include 'DIMENSIONS'
3978 include 'DIMENSIONS.ZSCOPT'
3979 include 'COMMON.GEO'
3980 include 'COMMON.LOCAL'
3981 include 'COMMON.VAR'
3982 include 'COMMON.SCROT'
3983 include 'COMMON.INTERACT'
3984 include 'COMMON.DERIV'
3985 include 'COMMON.CHAIN'
3986 include 'COMMON.IOUNITS'
3987 include 'COMMON.NAMES'
3988 include 'COMMON.FFIELD'
3989 include 'COMMON.CONTROL'
3990 include 'COMMON.VECTORS'
3991 double precision x_prime(3),y_prime(3),z_prime(3)
3992 & , sumene,dsc_i,dp2_i,x(65),
3993 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3994 & de_dxx,de_dyy,de_dzz,de_dt
3995 double precision s1_t,s1_6_t,s2_t,s2_6_t
3997 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3998 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3999 & dt_dCi(3),dt_dCi1(3)
4000 common /sccalc/ time11,time12,time112,theti,it,nlobit
4003 do i=loc_start,loc_end
4004 if (itype(i).eq.ntyp1) cycle
4005 costtab(i+1) =dcos(theta(i+1))
4006 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4007 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4008 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4009 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4010 cosfac=dsqrt(cosfac2)
4011 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4012 sinfac=dsqrt(sinfac2)
4014 if (it.eq.10) goto 1
4016 C Compute the axes of tghe local cartesian coordinates system; store in
4017 c x_prime, y_prime and z_prime
4024 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4025 C & dc_norm(3,i+nres)
4027 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4028 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4031 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4034 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4035 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4036 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4037 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4038 c & " xy",scalar(x_prime(1),y_prime(1)),
4039 c & " xz",scalar(x_prime(1),z_prime(1)),
4040 c & " yy",scalar(y_prime(1),y_prime(1)),
4041 c & " yz",scalar(y_prime(1),z_prime(1)),
4042 c & " zz",scalar(z_prime(1),z_prime(1))
4044 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4045 C to local coordinate system. Store in xx, yy, zz.
4051 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4052 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4053 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4060 C Compute the energy of the ith side cbain
4062 c write (2,*) "xx",xx," yy",yy," zz",zz
4065 x(j) = sc_parmin(j,it)
4068 Cc diagnostics - remove later
4070 yy1 = dsin(alph(2))*dcos(omeg(2))
4071 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4072 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4073 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4075 C," --- ", xx_w,yy_w,zz_w
4078 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4079 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4081 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4082 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4084 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4085 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4086 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4087 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4088 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4090 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4091 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4092 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4093 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4094 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4096 dsc_i = 0.743d0+x(61)
4098 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4099 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4100 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4101 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4102 s1=(1+x(63))/(0.1d0 + dscp1)
4103 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4104 s2=(1+x(65))/(0.1d0 + dscp2)
4105 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4106 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4107 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4108 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4110 c & dscp1,dscp2,sumene
4111 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4112 escloc = escloc + sumene
4113 c write (2,*) "escloc",escloc
4114 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4116 if (.not. calc_grad) goto 1
4119 C This section to check the numerical derivatives of the energy of ith side
4120 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4121 C #define DEBUG in the code to turn it on.
4123 write (2,*) "sumene =",sumene
4127 write (2,*) xx,yy,zz
4128 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4129 de_dxx_num=(sumenep-sumene)/aincr
4131 write (2,*) "xx+ sumene from enesc=",sumenep
4134 write (2,*) xx,yy,zz
4135 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4136 de_dyy_num=(sumenep-sumene)/aincr
4138 write (2,*) "yy+ sumene from enesc=",sumenep
4141 write (2,*) xx,yy,zz
4142 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4143 de_dzz_num=(sumenep-sumene)/aincr
4145 write (2,*) "zz+ sumene from enesc=",sumenep
4146 costsave=cost2tab(i+1)
4147 sintsave=sint2tab(i+1)
4148 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4149 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4150 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4151 de_dt_num=(sumenep-sumene)/aincr
4152 write (2,*) " t+ sumene from enesc=",sumenep
4153 cost2tab(i+1)=costsave
4154 sint2tab(i+1)=sintsave
4155 C End of diagnostics section.
4158 C Compute the gradient of esc
4160 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4161 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4162 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4163 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4164 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4165 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4166 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4167 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4168 pom1=(sumene3*sint2tab(i+1)+sumene1)
4169 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4170 pom2=(sumene4*cost2tab(i+1)+sumene2)
4171 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4172 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4173 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4174 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4176 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4177 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4178 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4180 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4181 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4182 & +(pom1+pom2)*pom_dx
4184 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4187 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4188 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4189 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4191 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4192 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4193 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4194 & +x(59)*zz**2 +x(60)*xx*zz
4195 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4196 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4197 & +(pom1-pom2)*pom_dy
4199 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4202 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4203 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4204 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4205 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4206 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4207 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4208 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4209 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4211 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4214 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4215 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4216 & +pom1*pom_dt1+pom2*pom_dt2
4218 write(2,*), "de_dt = ", de_dt,de_dt_num
4222 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4223 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4224 cosfac2xx=cosfac2*xx
4225 sinfac2yy=sinfac2*yy
4227 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4229 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4231 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4232 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4233 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4234 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4235 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4236 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4237 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4238 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4239 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4240 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4244 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4245 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4246 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4247 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4250 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4251 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4252 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4254 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4255 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4259 dXX_Ctab(k,i)=dXX_Ci(k)
4260 dXX_C1tab(k,i)=dXX_Ci1(k)
4261 dYY_Ctab(k,i)=dYY_Ci(k)
4262 dYY_C1tab(k,i)=dYY_Ci1(k)
4263 dZZ_Ctab(k,i)=dZZ_Ci(k)
4264 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4265 dXX_XYZtab(k,i)=dXX_XYZ(k)
4266 dYY_XYZtab(k,i)=dYY_XYZ(k)
4267 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4271 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4272 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4273 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4274 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4275 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4277 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4278 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4279 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4280 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4281 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4282 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4283 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4284 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4286 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4287 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4289 C to check gradient call subroutine check_grad
4296 c------------------------------------------------------------------------------
4297 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4299 C This procedure calculates two-body contact function g(rij) and its derivative:
4302 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4305 C where x=(rij-r0ij)/delta
4307 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4310 double precision rij,r0ij,eps0ij,fcont,fprimcont
4311 double precision x,x2,x4,delta
4315 if (x.lt.-1.0D0) then
4318 else if (x.le.1.0D0) then
4321 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4322 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4329 c------------------------------------------------------------------------------
4330 subroutine splinthet(theti,delta,ss,ssder)
4331 implicit real*8 (a-h,o-z)
4332 include 'DIMENSIONS'
4333 include 'DIMENSIONS.ZSCOPT'
4334 include 'COMMON.VAR'
4335 include 'COMMON.GEO'
4338 if (theti.gt.pipol) then
4339 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4341 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4346 c------------------------------------------------------------------------------
4347 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4349 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4350 double precision ksi,ksi2,ksi3,a1,a2,a3
4351 a1=fprim0*delta/(f1-f0)
4357 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4358 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4361 c------------------------------------------------------------------------------
4362 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4364 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4365 double precision ksi,ksi2,ksi3,a1,a2,a3
4370 a2=3*(f1x-f0x)-2*fprim0x*delta
4371 a3=fprim0x*delta-2*(f1x-f0x)
4372 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4375 C-----------------------------------------------------------------------------
4377 C-----------------------------------------------------------------------------
4378 subroutine etor(etors,edihcnstr,fact)
4379 implicit real*8 (a-h,o-z)
4380 include 'DIMENSIONS'
4381 include 'DIMENSIONS.ZSCOPT'
4382 include 'COMMON.VAR'
4383 include 'COMMON.GEO'
4384 include 'COMMON.LOCAL'
4385 include 'COMMON.TORSION'
4386 include 'COMMON.INTERACT'
4387 include 'COMMON.DERIV'
4388 include 'COMMON.CHAIN'
4389 include 'COMMON.NAMES'
4390 include 'COMMON.IOUNITS'
4391 include 'COMMON.FFIELD'
4392 include 'COMMON.TORCNSTR'
4394 C Set lprn=.true. for debugging
4398 do i=iphi_start,iphi_end
4399 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4400 & .or. itype(i).eq.ntyp1) cycle
4401 itori=itortyp(itype(i-2))
4402 itori1=itortyp(itype(i-1))
4405 C Proline-Proline pair is a special case...
4406 if (itori.eq.3 .and. itori1.eq.3) then
4407 if (phii.gt.-dwapi3) then
4409 fac=1.0D0/(1.0D0-cosphi)
4410 etorsi=v1(1,3,3)*fac
4411 etorsi=etorsi+etorsi
4412 etors=etors+etorsi-v1(1,3,3)
4413 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4416 v1ij=v1(j+1,itori,itori1)
4417 v2ij=v2(j+1,itori,itori1)
4420 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4421 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4425 v1ij=v1(j,itori,itori1)
4426 v2ij=v2(j,itori,itori1)
4429 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4430 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4434 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4435 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4436 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4437 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4438 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4440 ! 6/20/98 - dihedral angle constraints
4443 itori=idih_constr(i)
4446 if (difi.gt.drange(i)) then
4448 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4449 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4450 else if (difi.lt.-drange(i)) then
4452 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4453 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4455 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4456 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4458 ! write (iout,*) 'edihcnstr',edihcnstr
4461 c------------------------------------------------------------------------------
4463 subroutine etor(etors,edihcnstr,fact)
4464 implicit real*8 (a-h,o-z)
4465 include 'DIMENSIONS'
4466 include 'DIMENSIONS.ZSCOPT'
4467 include 'COMMON.VAR'
4468 include 'COMMON.GEO'
4469 include 'COMMON.LOCAL'
4470 include 'COMMON.TORSION'
4471 include 'COMMON.INTERACT'
4472 include 'COMMON.DERIV'
4473 include 'COMMON.CHAIN'
4474 include 'COMMON.NAMES'
4475 include 'COMMON.IOUNITS'
4476 include 'COMMON.FFIELD'
4477 include 'COMMON.TORCNSTR'
4479 C Set lprn=.true. for debugging
4483 do i=iphi_start,iphi_end
4484 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4485 & .or. itype(i).eq.ntyp1) cycle
4486 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4487 if (iabs(itype(i)).eq.20) then
4492 itori=itortyp(itype(i-2))
4493 itori1=itortyp(itype(i-1))
4496 C Regular cosine and sine terms
4497 do j=1,nterm(itori,itori1,iblock)
4498 v1ij=v1(j,itori,itori1,iblock)
4499 v2ij=v2(j,itori,itori1,iblock)
4502 etors=etors+v1ij*cosphi+v2ij*sinphi
4503 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4507 C E = SUM ----------------------------------- - v1
4508 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4510 cosphi=dcos(0.5d0*phii)
4511 sinphi=dsin(0.5d0*phii)
4512 do j=1,nlor(itori,itori1,iblock)
4513 vl1ij=vlor1(j,itori,itori1)
4514 vl2ij=vlor2(j,itori,itori1)
4515 vl3ij=vlor3(j,itori,itori1)
4516 pom=vl2ij*cosphi+vl3ij*sinphi
4517 pom1=1.0d0/(pom*pom+1.0d0)
4518 etors=etors+vl1ij*pom1
4519 c if (energy_dec) etors_ii=etors_ii+
4522 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4524 C Subtract the constant term
4525 etors=etors-v0(itori,itori1,iblock)
4527 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4528 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4529 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4530 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4531 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4534 ! 6/20/98 - dihedral angle constraints
4537 itori=idih_constr(i)
4539 difi=pinorm(phii-phi0(i))
4541 if (difi.gt.drange(i)) then
4543 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4544 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4545 edihi=0.25d0*ftors*difi**4
4546 else if (difi.lt.-drange(i)) then
4548 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4549 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4550 edihi=0.25d0*ftors*difi**4
4554 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4556 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4557 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4559 ! write (iout,*) 'edihcnstr',edihcnstr
4562 c----------------------------------------------------------------------------
4563 subroutine etor_d(etors_d,fact2)
4564 C 6/23/01 Compute double torsional energy
4565 implicit real*8 (a-h,o-z)
4566 include 'DIMENSIONS'
4567 include 'DIMENSIONS.ZSCOPT'
4568 include 'COMMON.VAR'
4569 include 'COMMON.GEO'
4570 include 'COMMON.LOCAL'
4571 include 'COMMON.TORSION'
4572 include 'COMMON.INTERACT'
4573 include 'COMMON.DERIV'
4574 include 'COMMON.CHAIN'
4575 include 'COMMON.NAMES'
4576 include 'COMMON.IOUNITS'
4577 include 'COMMON.FFIELD'
4578 include 'COMMON.TORCNSTR'
4580 C Set lprn=.true. for debugging
4584 do i=iphi_start,iphi_end-1
4585 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4586 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4587 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4589 itori=itortyp(itype(i-2))
4590 itori1=itortyp(itype(i-1))
4591 itori2=itortyp(itype(i))
4597 if (iabs(itype(i+1)).eq.20) iblock=2
4598 C Regular cosine and sine terms
4599 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4600 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4601 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4602 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4603 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4604 cosphi1=dcos(j*phii)
4605 sinphi1=dsin(j*phii)
4606 cosphi2=dcos(j*phii1)
4607 sinphi2=dsin(j*phii1)
4608 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4609 & v2cij*cosphi2+v2sij*sinphi2
4610 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4611 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4613 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4615 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4616 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4617 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4618 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4619 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4620 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4621 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4622 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4623 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4624 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4625 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4626 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4627 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4628 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4631 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4632 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4638 c------------------------------------------------------------------------------
4639 subroutine eback_sc_corr(esccor)
4640 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4641 c conformational states; temporarily implemented as differences
4642 c between UNRES torsional potentials (dependent on three types of
4643 c residues) and the torsional potentials dependent on all 20 types
4644 c of residues computed from AM1 energy surfaces of terminally-blocked
4645 c amino-acid residues.
4646 implicit real*8 (a-h,o-z)
4647 include 'DIMENSIONS'
4648 include 'DIMENSIONS.ZSCOPT'
4649 include 'COMMON.VAR'
4650 include 'COMMON.GEO'
4651 include 'COMMON.LOCAL'
4652 include 'COMMON.TORSION'
4653 include 'COMMON.SCCOR'
4654 include 'COMMON.INTERACT'
4655 include 'COMMON.DERIV'
4656 include 'COMMON.CHAIN'
4657 include 'COMMON.NAMES'
4658 include 'COMMON.IOUNITS'
4659 include 'COMMON.FFIELD'
4660 include 'COMMON.CONTROL'
4662 C Set lprn=.true. for debugging
4665 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4667 do i=itau_start,itau_end
4668 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4670 isccori=isccortyp(itype(i-2))
4671 isccori1=isccortyp(itype(i-1))
4673 do intertyp=1,3 !intertyp
4674 cc Added 09 May 2012 (Adasko)
4675 cc Intertyp means interaction type of backbone mainchain correlation:
4676 c 1 = SC...Ca...Ca...Ca
4677 c 2 = Ca...Ca...Ca...SC
4678 c 3 = SC...Ca...Ca...SCi
4680 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4681 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4682 & (itype(i-1).eq.ntyp1)))
4683 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4684 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4685 & .or.(itype(i).eq.ntyp1)))
4686 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4687 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4688 & (itype(i-3).eq.ntyp1)))) cycle
4689 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4690 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4692 do j=1,nterm_sccor(isccori,isccori1)
4693 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4694 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4695 cosphi=dcos(j*tauangle(intertyp,i))
4696 sinphi=dsin(j*tauangle(intertyp,i))
4697 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4698 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4700 C write (iout,*)"EBACK_SC_COR",esccor,i
4701 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4702 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4703 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4705 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4706 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4707 & (v1sccor(j,1,itori,itori1),j=1,6)
4708 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4709 c gsccor_loc(i-3)=gloci
4714 c------------------------------------------------------------------------------
4715 subroutine multibody(ecorr)
4716 C This subroutine calculates multi-body contributions to energy following
4717 C the idea of Skolnick et al. If side chains I and J make a contact and
4718 C at the same time side chains I+1 and J+1 make a contact, an extra
4719 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4720 implicit real*8 (a-h,o-z)
4721 include 'DIMENSIONS'
4722 include 'COMMON.IOUNITS'
4723 include 'COMMON.DERIV'
4724 include 'COMMON.INTERACT'
4725 include 'COMMON.CONTACTS'
4726 double precision gx(3),gx1(3)
4729 C Set lprn=.true. for debugging
4733 write (iout,'(a)') 'Contact function values:'
4735 write (iout,'(i2,20(1x,i2,f10.5))')
4736 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4751 num_conti=num_cont(i)
4752 num_conti1=num_cont(i1)
4757 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4758 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4759 cd & ' ishift=',ishift
4760 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4761 C The system gains extra energy.
4762 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4763 endif ! j1==j+-ishift
4772 c------------------------------------------------------------------------------
4773 double precision function esccorr(i,j,k,l,jj,kk)
4774 implicit real*8 (a-h,o-z)
4775 include 'DIMENSIONS'
4776 include 'COMMON.IOUNITS'
4777 include 'COMMON.DERIV'
4778 include 'COMMON.INTERACT'
4779 include 'COMMON.CONTACTS'
4780 double precision gx(3),gx1(3)
4785 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4786 C Calculate the multi-body contribution to energy.
4787 C Calculate multi-body contributions to the gradient.
4788 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4789 cd & k,l,(gacont(m,kk,k),m=1,3)
4791 gx(m) =ekl*gacont(m,jj,i)
4792 gx1(m)=eij*gacont(m,kk,k)
4793 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4794 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4795 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4796 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4800 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4805 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4811 c------------------------------------------------------------------------------
4813 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4814 implicit real*8 (a-h,o-z)
4815 include 'DIMENSIONS'
4816 integer dimen1,dimen2,atom,indx
4817 double precision buffer(dimen1,dimen2)
4818 double precision zapas
4819 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4820 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
4821 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4822 num_kont=num_cont_hb(atom)
4826 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4829 buffer(i,indx+22)=facont_hb(i,atom)
4830 buffer(i,indx+23)=ees0p(i,atom)
4831 buffer(i,indx+24)=ees0m(i,atom)
4832 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4834 buffer(1,indx+26)=dfloat(num_kont)
4837 c------------------------------------------------------------------------------
4838 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4839 implicit real*8 (a-h,o-z)
4840 include 'DIMENSIONS'
4841 integer dimen1,dimen2,atom,indx
4842 double precision buffer(dimen1,dimen2)
4843 double precision zapas
4844 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4845 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
4846 & ees0m(ntyp,maxres),
4847 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4848 num_kont=buffer(1,indx+26)
4849 num_kont_old=num_cont_hb(atom)
4850 num_cont_hb(atom)=num_kont+num_kont_old
4855 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4858 facont_hb(ii,atom)=buffer(i,indx+22)
4859 ees0p(ii,atom)=buffer(i,indx+23)
4860 ees0m(ii,atom)=buffer(i,indx+24)
4861 jcont_hb(ii,atom)=buffer(i,indx+25)
4865 c------------------------------------------------------------------------------
4867 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4868 C This subroutine calculates multi-body contributions to hydrogen-bonding
4869 implicit real*8 (a-h,o-z)
4870 include 'DIMENSIONS'
4871 include 'DIMENSIONS.ZSCOPT'
4872 include 'COMMON.IOUNITS'
4874 include 'COMMON.INFO'
4876 include 'COMMON.FFIELD'
4877 include 'COMMON.DERIV'
4878 include 'COMMON.INTERACT'
4879 include 'COMMON.CONTACTS'
4881 parameter (max_cont=maxconts)
4882 parameter (max_dim=2*(8*3+2))
4883 parameter (msglen1=max_cont*max_dim*4)
4884 parameter (msglen2=2*msglen1)
4885 integer source,CorrelType,CorrelID,Error
4886 double precision buffer(max_cont,max_dim)
4888 double precision gx(3),gx1(3)
4891 C Set lprn=.true. for debugging
4896 if (fgProcs.le.1) goto 30
4898 write (iout,'(a)') 'Contact function values:'
4900 write (iout,'(2i3,50(1x,i2,f5.2))')
4901 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4902 & j=1,num_cont_hb(i))
4905 C Caution! Following code assumes that electrostatic interactions concerning
4906 C a given atom are split among at most two processors!
4916 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4919 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4920 if (MyRank.gt.0) then
4921 C Send correlation contributions to the preceding processor
4923 nn=num_cont_hb(iatel_s)
4924 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4925 cd write (iout,*) 'The BUFFER array:'
4927 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4929 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4931 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4932 C Clear the contacts of the atom passed to the neighboring processor
4933 nn=num_cont_hb(iatel_s+1)
4935 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4937 num_cont_hb(iatel_s)=0
4939 cd write (iout,*) 'Processor ',MyID,MyRank,
4940 cd & ' is sending correlation contribution to processor',MyID-1,
4941 cd & ' msglen=',msglen
4942 cd write (*,*) 'Processor ',MyID,MyRank,
4943 cd & ' is sending correlation contribution to processor',MyID-1,
4944 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4945 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4946 cd write (iout,*) 'Processor ',MyID,
4947 cd & ' has sent correlation contribution to processor',MyID-1,
4948 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4949 cd write (*,*) 'Processor ',MyID,
4950 cd & ' has sent correlation contribution to processor',MyID-1,
4951 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4953 endif ! (MyRank.gt.0)
4957 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4958 if (MyRank.lt.fgProcs-1) then
4959 C Receive correlation contributions from the next processor
4961 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4962 cd write (iout,*) 'Processor',MyID,
4963 cd & ' is receiving correlation contribution from processor',MyID+1,
4964 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4965 cd write (*,*) 'Processor',MyID,
4966 cd & ' is receiving correlation contribution from processor',MyID+1,
4967 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4969 do while (nbytes.le.0)
4970 call mp_probe(MyID+1,CorrelType,nbytes)
4972 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4973 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4974 cd write (iout,*) 'Processor',MyID,
4975 cd & ' has received correlation contribution from processor',MyID+1,
4976 cd & ' msglen=',msglen,' nbytes=',nbytes
4977 cd write (iout,*) 'The received BUFFER array:'
4979 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4981 if (msglen.eq.msglen1) then
4982 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4983 else if (msglen.eq.msglen2) then
4984 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4985 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4988 & 'ERROR!!!! message length changed while processing correlations.'
4990 & 'ERROR!!!! message length changed while processing correlations.'
4991 call mp_stopall(Error)
4992 endif ! msglen.eq.msglen1
4993 endif ! MyRank.lt.fgProcs-1
5000 write (iout,'(a)') 'Contact function values:'
5002 write (iout,'(2i3,50(1x,i2,f5.2))')
5003 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5004 & j=1,num_cont_hb(i))
5008 C Remove the loop below after debugging !!!
5015 C Calculate the local-electrostatic correlation terms
5016 do i=iatel_s,iatel_e+1
5018 num_conti=num_cont_hb(i)
5019 num_conti1=num_cont_hb(i+1)
5024 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5025 c & ' jj=',jj,' kk=',kk
5026 if (j1.eq.j+1 .or. j1.eq.j-1) then
5027 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5028 C The system gains extra energy.
5029 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5031 else if (j1.eq.j) then
5032 C Contacts I-J and I-(J+1) occur simultaneously.
5033 C The system loses extra energy.
5034 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5039 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5040 c & ' jj=',jj,' kk=',kk
5042 C Contacts I-J and (I+1)-J occur simultaneously.
5043 C The system loses extra energy.
5044 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5051 c------------------------------------------------------------------------------
5052 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5054 C This subroutine calculates multi-body contributions to hydrogen-bonding
5055 implicit real*8 (a-h,o-z)
5056 include 'DIMENSIONS'
5057 include 'DIMENSIONS.ZSCOPT'
5058 include 'COMMON.IOUNITS'
5060 include 'COMMON.INFO'
5062 include 'COMMON.FFIELD'
5063 include 'COMMON.DERIV'
5064 include 'COMMON.INTERACT'
5065 include 'COMMON.CONTACTS'
5067 parameter (max_cont=maxconts)
5068 parameter (max_dim=2*(8*3+2))
5069 parameter (msglen1=max_cont*max_dim*4)
5070 parameter (msglen2=2*msglen1)
5071 integer source,CorrelType,CorrelID,Error
5072 double precision buffer(max_cont,max_dim)
5074 double precision gx(3),gx1(3)
5077 C Set lprn=.true. for debugging
5083 if (fgProcs.le.1) goto 30
5085 write (iout,'(a)') 'Contact function values:'
5087 write (iout,'(2i3,50(1x,i2,f5.2))')
5088 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5089 & j=1,num_cont_hb(i))
5092 C Caution! Following code assumes that electrostatic interactions concerning
5093 C a given atom are split among at most two processors!
5103 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5106 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5107 if (MyRank.gt.0) then
5108 C Send correlation contributions to the preceding processor
5110 nn=num_cont_hb(iatel_s)
5111 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5112 cd write (iout,*) 'The BUFFER array:'
5114 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5116 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5118 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5119 C Clear the contacts of the atom passed to the neighboring processor
5120 nn=num_cont_hb(iatel_s+1)
5122 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5124 num_cont_hb(iatel_s)=0
5126 cd write (iout,*) 'Processor ',MyID,MyRank,
5127 cd & ' is sending correlation contribution to processor',MyID-1,
5128 cd & ' msglen=',msglen
5129 cd write (*,*) 'Processor ',MyID,MyRank,
5130 cd & ' is sending correlation contribution to processor',MyID-1,
5131 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5132 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5133 cd write (iout,*) 'Processor ',MyID,
5134 cd & ' has sent correlation contribution to processor',MyID-1,
5135 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5136 cd write (*,*) 'Processor ',MyID,
5137 cd & ' has sent correlation contribution to processor',MyID-1,
5138 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5140 endif ! (MyRank.gt.0)
5144 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5145 if (MyRank.lt.fgProcs-1) then
5146 C Receive correlation contributions from the next processor
5148 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5149 cd write (iout,*) 'Processor',MyID,
5150 cd & ' is receiving correlation contribution from processor',MyID+1,
5151 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5152 cd write (*,*) 'Processor',MyID,
5153 cd & ' is receiving correlation contribution from processor',MyID+1,
5154 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5156 do while (nbytes.le.0)
5157 call mp_probe(MyID+1,CorrelType,nbytes)
5159 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5160 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5161 cd write (iout,*) 'Processor',MyID,
5162 cd & ' has received correlation contribution from processor',MyID+1,
5163 cd & ' msglen=',msglen,' nbytes=',nbytes
5164 cd write (iout,*) 'The received BUFFER array:'
5166 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5168 if (msglen.eq.msglen1) then
5169 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5170 else if (msglen.eq.msglen2) then
5171 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5172 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5175 & 'ERROR!!!! message length changed while processing correlations.'
5177 & 'ERROR!!!! message length changed while processing correlations.'
5178 call mp_stopall(Error)
5179 endif ! msglen.eq.msglen1
5180 endif ! MyRank.lt.fgProcs-1
5187 write (iout,'(a)') 'Contact function values:'
5189 write (iout,'(2i3,50(1x,i2,f5.2))')
5190 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5191 & j=1,num_cont_hb(i))
5197 C Remove the loop below after debugging !!!
5204 C Calculate the dipole-dipole interaction energies
5205 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5206 do i=iatel_s,iatel_e+1
5207 num_conti=num_cont_hb(i)
5214 C Calculate the local-electrostatic correlation terms
5215 do i=iatel_s,iatel_e+1
5217 num_conti=num_cont_hb(i)
5218 num_conti1=num_cont_hb(i+1)
5223 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5224 c & ' jj=',jj,' kk=',kk
5225 if (j1.eq.j+1 .or. j1.eq.j-1) then
5226 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5227 C The system gains extra energy.
5229 sqd1=dsqrt(d_cont(jj,i))
5230 sqd2=dsqrt(d_cont(kk,i1))
5231 sred_geom = sqd1*sqd2
5232 IF (sred_geom.lt.cutoff_corr) THEN
5233 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5235 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5236 c & ' jj=',jj,' kk=',kk
5237 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5238 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5240 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5241 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5244 cd write (iout,*) 'sred_geom=',sred_geom,
5245 cd & ' ekont=',ekont,' fprim=',fprimcont
5246 call calc_eello(i,j,i+1,j1,jj,kk)
5247 if (wcorr4.gt.0.0d0)
5248 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5249 if (wcorr5.gt.0.0d0)
5250 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5251 c print *,"wcorr5",ecorr5
5252 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5253 cd write(2,*)'ijkl',i,j,i+1,j1
5254 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5255 & .or. wturn6.eq.0.0d0))then
5256 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5257 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5258 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5259 cd & 'ecorr6=',ecorr6
5260 cd write (iout,'(4e15.5)') sred_geom,
5261 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5262 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5263 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5264 else if (wturn6.gt.0.0d0
5265 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5266 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5267 eturn6=eturn6+eello_turn6(i,jj,kk)
5268 cd write (2,*) 'multibody_eello:eturn6',eturn6
5272 else if (j1.eq.j) then
5273 C Contacts I-J and I-(J+1) occur simultaneously.
5274 C The system loses extra energy.
5275 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5280 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5281 c & ' jj=',jj,' kk=',kk
5283 C Contacts I-J and (I+1)-J occur simultaneously.
5284 C The system loses extra energy.
5285 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5292 c------------------------------------------------------------------------------
5293 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5294 implicit real*8 (a-h,o-z)
5295 include 'DIMENSIONS'
5296 include 'COMMON.IOUNITS'
5297 include 'COMMON.DERIV'
5298 include 'COMMON.INTERACT'
5299 include 'COMMON.CONTACTS'
5300 double precision gx(3),gx1(3)
5310 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5311 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5312 C Following 4 lines for diagnostics.
5317 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5319 c write (iout,*)'Contacts have occurred for peptide groups',
5320 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5321 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5322 C Calculate the multi-body contribution to energy.
5323 ecorr=ecorr+ekont*ees
5325 C Calculate multi-body contributions to the gradient.
5327 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5328 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5329 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5330 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5331 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5332 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5333 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5334 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5335 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5336 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5337 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5338 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5339 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5340 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5344 gradcorr(ll,m)=gradcorr(ll,m)+
5345 & ees*ekl*gacont_hbr(ll,jj,i)-
5346 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5347 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5352 gradcorr(ll,m)=gradcorr(ll,m)+
5353 & ees*eij*gacont_hbr(ll,kk,k)-
5354 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5355 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5362 C---------------------------------------------------------------------------
5363 subroutine dipole(i,j,jj)
5364 implicit real*8 (a-h,o-z)
5365 include 'DIMENSIONS'
5366 include 'DIMENSIONS.ZSCOPT'
5367 include 'COMMON.IOUNITS'
5368 include 'COMMON.CHAIN'
5369 include 'COMMON.FFIELD'
5370 include 'COMMON.DERIV'
5371 include 'COMMON.INTERACT'
5372 include 'COMMON.CONTACTS'
5373 include 'COMMON.TORSION'
5374 include 'COMMON.VAR'
5375 include 'COMMON.GEO'
5376 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5378 iti1 = itortyp(itype(i+1))
5379 if (j.lt.nres-1) then
5380 if (itype(j).le.ntyp) then
5381 itj1 = itortyp(itype(j+1))
5389 dipi(iii,1)=Ub2(iii,i)
5390 dipderi(iii)=Ub2der(iii,i)
5391 dipi(iii,2)=b1(iii,iti1)
5392 dipj(iii,1)=Ub2(iii,j)
5393 dipderj(iii)=Ub2der(iii,j)
5394 dipj(iii,2)=b1(iii,itj1)
5398 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5401 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5404 if (.not.calc_grad) return
5409 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5413 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5418 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5419 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5421 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5423 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5425 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5429 C---------------------------------------------------------------------------
5430 subroutine calc_eello(i,j,k,l,jj,kk)
5432 C This subroutine computes matrices and vectors needed to calculate
5433 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5435 implicit real*8 (a-h,o-z)
5436 include 'DIMENSIONS'
5437 include 'DIMENSIONS.ZSCOPT'
5438 include 'COMMON.IOUNITS'
5439 include 'COMMON.CHAIN'
5440 include 'COMMON.DERIV'
5441 include 'COMMON.INTERACT'
5442 include 'COMMON.CONTACTS'
5443 include 'COMMON.TORSION'
5444 include 'COMMON.VAR'
5445 include 'COMMON.GEO'
5446 include 'COMMON.FFIELD'
5447 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5448 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5451 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5452 cd & ' jj=',jj,' kk=',kk
5453 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5456 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5457 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5460 call transpose2(aa1(1,1),aa1t(1,1))
5461 call transpose2(aa2(1,1),aa2t(1,1))
5464 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5465 & aa1tder(1,1,lll,kkk))
5466 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5467 & aa2tder(1,1,lll,kkk))
5471 C parallel orientation of the two CA-CA-CA frames.
5472 if (i.gt.1 .and. itype(i).le.ntyp) then
5473 iti=itortyp(itype(i))
5477 itk1=itortyp(itype(k+1))
5478 itj=itortyp(itype(j))
5479 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5480 itl1=itortyp(itype(l+1))
5484 C A1 kernel(j+1) A2T
5486 cd write (iout,'(3f10.5,5x,3f10.5)')
5487 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5489 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5490 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5491 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5492 C Following matrices are needed only for 6-th order cumulants
5493 IF (wcorr6.gt.0.0d0) THEN
5494 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5495 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5496 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5497 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5498 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5499 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5500 & ADtEAderx(1,1,1,1,1,1))
5502 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5503 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5504 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5505 & ADtEA1derx(1,1,1,1,1,1))
5507 C End 6-th order cumulants
5510 cd write (2,*) 'In calc_eello6'
5512 cd write (2,*) 'iii=',iii
5514 cd write (2,*) 'kkk=',kkk
5516 cd write (2,'(3(2f10.5),5x)')
5517 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5522 call transpose2(EUgder(1,1,k),auxmat(1,1))
5523 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5524 call transpose2(EUg(1,1,k),auxmat(1,1))
5525 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5526 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5530 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5531 & EAEAderx(1,1,lll,kkk,iii,1))
5535 C A1T kernel(i+1) A2
5536 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5537 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5538 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5539 C Following matrices are needed only for 6-th order cumulants
5540 IF (wcorr6.gt.0.0d0) THEN
5541 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5542 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5543 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5544 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5545 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5546 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5547 & ADtEAderx(1,1,1,1,1,2))
5548 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5549 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5550 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5551 & ADtEA1derx(1,1,1,1,1,2))
5553 C End 6-th order cumulants
5554 call transpose2(EUgder(1,1,l),auxmat(1,1))
5555 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5556 call transpose2(EUg(1,1,l),auxmat(1,1))
5557 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5558 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5562 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5563 & EAEAderx(1,1,lll,kkk,iii,2))
5568 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5569 C They are needed only when the fifth- or the sixth-order cumulants are
5571 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5572 call transpose2(AEA(1,1,1),auxmat(1,1))
5573 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5574 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5575 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5576 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5577 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5578 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5579 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5580 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5581 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5582 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5583 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5584 call transpose2(AEA(1,1,2),auxmat(1,1))
5585 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5586 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5587 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5588 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5589 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5590 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5591 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5592 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5593 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5594 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5595 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5596 C Calculate the Cartesian derivatives of the vectors.
5600 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5601 call matvec2(auxmat(1,1),b1(1,iti),
5602 & AEAb1derx(1,lll,kkk,iii,1,1))
5603 call matvec2(auxmat(1,1),Ub2(1,i),
5604 & AEAb2derx(1,lll,kkk,iii,1,1))
5605 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5606 & AEAb1derx(1,lll,kkk,iii,2,1))
5607 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5608 & AEAb2derx(1,lll,kkk,iii,2,1))
5609 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5610 call matvec2(auxmat(1,1),b1(1,itj),
5611 & AEAb1derx(1,lll,kkk,iii,1,2))
5612 call matvec2(auxmat(1,1),Ub2(1,j),
5613 & AEAb2derx(1,lll,kkk,iii,1,2))
5614 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5615 & AEAb1derx(1,lll,kkk,iii,2,2))
5616 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5617 & AEAb2derx(1,lll,kkk,iii,2,2))
5624 C Antiparallel orientation of the two CA-CA-CA frames.
5625 if (i.gt.1 .and. itype(i).le.ntyp) then
5626 iti=itortyp(itype(i))
5630 itk1=itortyp(itype(k+1))
5631 itl=itortyp(itype(l))
5632 itj=itortyp(itype(j))
5633 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5634 itj1=itortyp(itype(j+1))
5638 C A2 kernel(j-1)T A1T
5639 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5640 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5641 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5642 C Following matrices are needed only for 6-th order cumulants
5643 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5644 & j.eq.i+4 .and. l.eq.i+3)) THEN
5645 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5646 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5647 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5648 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5649 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5650 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5651 & ADtEAderx(1,1,1,1,1,1))
5652 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5653 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5654 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5655 & ADtEA1derx(1,1,1,1,1,1))
5657 C End 6-th order cumulants
5658 call transpose2(EUgder(1,1,k),auxmat(1,1))
5659 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5660 call transpose2(EUg(1,1,k),auxmat(1,1))
5661 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5662 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5666 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5667 & EAEAderx(1,1,lll,kkk,iii,1))
5671 C A2T kernel(i+1)T A1
5672 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5673 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5674 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5675 C Following matrices are needed only for 6-th order cumulants
5676 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5677 & j.eq.i+4 .and. l.eq.i+3)) THEN
5678 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5679 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5680 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5681 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5682 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5683 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5684 & ADtEAderx(1,1,1,1,1,2))
5685 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5686 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5687 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5688 & ADtEA1derx(1,1,1,1,1,2))
5690 C End 6-th order cumulants
5691 call transpose2(EUgder(1,1,j),auxmat(1,1))
5692 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5693 call transpose2(EUg(1,1,j),auxmat(1,1))
5694 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5695 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5699 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5700 & EAEAderx(1,1,lll,kkk,iii,2))
5705 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5706 C They are needed only when the fifth- or the sixth-order cumulants are
5708 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5709 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5710 call transpose2(AEA(1,1,1),auxmat(1,1))
5711 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5712 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5713 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5714 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5715 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5716 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5717 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5718 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5719 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5720 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5721 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5722 call transpose2(AEA(1,1,2),auxmat(1,1))
5723 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5724 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5725 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5726 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5727 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5728 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5729 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5730 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5731 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5732 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5733 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5734 C Calculate the Cartesian derivatives of the vectors.
5738 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5739 call matvec2(auxmat(1,1),b1(1,iti),
5740 & AEAb1derx(1,lll,kkk,iii,1,1))
5741 call matvec2(auxmat(1,1),Ub2(1,i),
5742 & AEAb2derx(1,lll,kkk,iii,1,1))
5743 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5744 & AEAb1derx(1,lll,kkk,iii,2,1))
5745 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5746 & AEAb2derx(1,lll,kkk,iii,2,1))
5747 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5748 call matvec2(auxmat(1,1),b1(1,itl),
5749 & AEAb1derx(1,lll,kkk,iii,1,2))
5750 call matvec2(auxmat(1,1),Ub2(1,l),
5751 & AEAb2derx(1,lll,kkk,iii,1,2))
5752 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5753 & AEAb1derx(1,lll,kkk,iii,2,2))
5754 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5755 & AEAb2derx(1,lll,kkk,iii,2,2))
5764 C---------------------------------------------------------------------------
5765 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5766 & KK,KKderg,AKA,AKAderg,AKAderx)
5770 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5771 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5772 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5777 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5779 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5782 cd if (lprn) write (2,*) 'In kernel'
5784 cd if (lprn) write (2,*) 'kkk=',kkk
5786 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5787 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5789 cd write (2,*) 'lll=',lll
5790 cd write (2,*) 'iii=1'
5792 cd write (2,'(3(2f10.5),5x)')
5793 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5796 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5797 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5799 cd write (2,*) 'lll=',lll
5800 cd write (2,*) 'iii=2'
5802 cd write (2,'(3(2f10.5),5x)')
5803 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5810 C---------------------------------------------------------------------------
5811 double precision function eello4(i,j,k,l,jj,kk)
5812 implicit real*8 (a-h,o-z)
5813 include 'DIMENSIONS'
5814 include 'DIMENSIONS.ZSCOPT'
5815 include 'COMMON.IOUNITS'
5816 include 'COMMON.CHAIN'
5817 include 'COMMON.DERIV'
5818 include 'COMMON.INTERACT'
5819 include 'COMMON.CONTACTS'
5820 include 'COMMON.TORSION'
5821 include 'COMMON.VAR'
5822 include 'COMMON.GEO'
5823 double precision pizda(2,2),ggg1(3),ggg2(3)
5824 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5828 cd print *,'eello4:',i,j,k,l,jj,kk
5829 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5830 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5831 cold eij=facont_hb(jj,i)
5832 cold ekl=facont_hb(kk,k)
5834 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5836 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5837 gcorr_loc(k-1)=gcorr_loc(k-1)
5838 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5840 gcorr_loc(l-1)=gcorr_loc(l-1)
5841 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5843 gcorr_loc(j-1)=gcorr_loc(j-1)
5844 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5849 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5850 & -EAEAderx(2,2,lll,kkk,iii,1)
5851 cd derx(lll,kkk,iii)=0.0d0
5855 cd gcorr_loc(l-1)=0.0d0
5856 cd gcorr_loc(j-1)=0.0d0
5857 cd gcorr_loc(k-1)=0.0d0
5859 cd write (iout,*)'Contacts have occurred for peptide groups',
5860 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5861 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5862 if (j.lt.nres-1) then
5869 if (l.lt.nres-1) then
5877 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5878 ggg1(ll)=eel4*g_contij(ll,1)
5879 ggg2(ll)=eel4*g_contij(ll,2)
5880 ghalf=0.5d0*ggg1(ll)
5882 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5883 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5884 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5885 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5886 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5887 ghalf=0.5d0*ggg2(ll)
5889 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5890 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5891 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5892 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5897 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5898 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5903 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5904 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5910 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5915 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5919 cd write (2,*) iii,gcorr_loc(iii)
5923 cd write (2,*) 'ekont',ekont
5924 cd write (iout,*) 'eello4',ekont*eel4
5927 C---------------------------------------------------------------------------
5928 double precision function eello5(i,j,k,l,jj,kk)
5929 implicit real*8 (a-h,o-z)
5930 include 'DIMENSIONS'
5931 include 'DIMENSIONS.ZSCOPT'
5932 include 'COMMON.IOUNITS'
5933 include 'COMMON.CHAIN'
5934 include 'COMMON.DERIV'
5935 include 'COMMON.INTERACT'
5936 include 'COMMON.CONTACTS'
5937 include 'COMMON.TORSION'
5938 include 'COMMON.VAR'
5939 include 'COMMON.GEO'
5940 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5941 double precision ggg1(3),ggg2(3)
5942 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5947 C /l\ / \ \ / \ / \ / C
5948 C / \ / \ \ / \ / \ / C
5949 C j| o |l1 | o | o| o | | o |o C
5950 C \ |/k\| |/ \| / |/ \| |/ \| C
5951 C \i/ \ / \ / / \ / \ C
5953 C (I) (II) (III) (IV) C
5955 C eello5_1 eello5_2 eello5_3 eello5_4 C
5957 C Antiparallel chains C
5960 C /j\ / \ \ / \ / \ / C
5961 C / \ / \ \ / \ / \ / C
5962 C j1| o |l | o | o| o | | o |o C
5963 C \ |/k\| |/ \| / |/ \| |/ \| C
5964 C \i/ \ / \ / / \ / \ C
5966 C (I) (II) (III) (IV) C
5968 C eello5_1 eello5_2 eello5_3 eello5_4 C
5970 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5972 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5973 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5978 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5980 itk=itortyp(itype(k))
5981 itl=itortyp(itype(l))
5982 itj=itortyp(itype(j))
5987 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5988 cd & eel5_3_num,eel5_4_num)
5992 derx(lll,kkk,iii)=0.0d0
5996 cd eij=facont_hb(jj,i)
5997 cd ekl=facont_hb(kk,k)
5999 cd write (iout,*)'Contacts have occurred for peptide groups',
6000 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6002 C Contribution from the graph I.
6003 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6004 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6005 call transpose2(EUg(1,1,k),auxmat(1,1))
6006 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6007 vv(1)=pizda(1,1)-pizda(2,2)
6008 vv(2)=pizda(1,2)+pizda(2,1)
6009 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6010 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6012 C Explicit gradient in virtual-dihedral angles.
6013 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6014 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6015 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6016 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6017 call matmat2(AEA(1,1,1),auxmat1(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(AEAb2(1,1,1),Ub2der(1,k))
6022 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6023 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6024 vv(1)=pizda(1,1)-pizda(2,2)
6025 vv(2)=pizda(1,2)+pizda(2,1)
6027 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6028 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6029 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6031 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6032 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6033 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6035 C Cartesian gradient
6039 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6041 vv(1)=pizda(1,1)-pizda(2,2)
6042 vv(2)=pizda(1,2)+pizda(2,1)
6043 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6044 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6045 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6052 C Contribution from graph II
6053 call transpose2(EE(1,1,itk),auxmat(1,1))
6054 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6055 vv(1)=pizda(1,1)+pizda(2,2)
6056 vv(2)=pizda(2,1)-pizda(1,2)
6057 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6058 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6060 C Explicit gradient in virtual-dihedral angles.
6061 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6062 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6063 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6064 vv(1)=pizda(1,1)+pizda(2,2)
6065 vv(2)=pizda(2,1)-pizda(1,2)
6067 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6068 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6069 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6071 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6072 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6073 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6075 C Cartesian gradient
6079 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6081 vv(1)=pizda(1,1)+pizda(2,2)
6082 vv(2)=pizda(2,1)-pizda(1,2)
6083 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6084 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6085 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6094 C Parallel orientation
6095 C Contribution from graph III
6096 call transpose2(EUg(1,1,l),auxmat(1,1))
6097 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6098 vv(1)=pizda(1,1)-pizda(2,2)
6099 vv(2)=pizda(1,2)+pizda(2,1)
6100 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6101 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6103 C Explicit gradient in virtual-dihedral angles.
6104 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6105 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6106 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6107 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6108 vv(1)=pizda(1,1)-pizda(2,2)
6109 vv(2)=pizda(1,2)+pizda(2,1)
6110 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6111 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6112 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6113 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6114 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6115 vv(1)=pizda(1,1)-pizda(2,2)
6116 vv(2)=pizda(1,2)+pizda(2,1)
6117 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6118 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6119 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6120 C Cartesian gradient
6124 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6126 vv(1)=pizda(1,1)-pizda(2,2)
6127 vv(2)=pizda(1,2)+pizda(2,1)
6128 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6129 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6130 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6136 C Contribution from graph IV
6138 call transpose2(EE(1,1,itl),auxmat(1,1))
6139 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6140 vv(1)=pizda(1,1)+pizda(2,2)
6141 vv(2)=pizda(2,1)-pizda(1,2)
6142 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6143 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6145 C Explicit gradient in virtual-dihedral angles.
6146 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6147 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6148 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6149 vv(1)=pizda(1,1)+pizda(2,2)
6150 vv(2)=pizda(2,1)-pizda(1,2)
6151 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6152 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6153 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6154 C Cartesian gradient
6158 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6160 vv(1)=pizda(1,1)+pizda(2,2)
6161 vv(2)=pizda(2,1)-pizda(1,2)
6162 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6163 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6164 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6170 C Antiparallel orientation
6171 C Contribution from graph III
6173 call transpose2(EUg(1,1,j),auxmat(1,1))
6174 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6175 vv(1)=pizda(1,1)-pizda(2,2)
6176 vv(2)=pizda(1,2)+pizda(2,1)
6177 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6178 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6180 C Explicit gradient in virtual-dihedral angles.
6181 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6182 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6183 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6184 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6185 vv(1)=pizda(1,1)-pizda(2,2)
6186 vv(2)=pizda(1,2)+pizda(2,1)
6187 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6188 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6189 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6190 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6191 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6192 vv(1)=pizda(1,1)-pizda(2,2)
6193 vv(2)=pizda(1,2)+pizda(2,1)
6194 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6195 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6196 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6197 C Cartesian gradient
6201 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6203 vv(1)=pizda(1,1)-pizda(2,2)
6204 vv(2)=pizda(1,2)+pizda(2,1)
6205 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6206 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6207 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6213 C Contribution from graph IV
6215 call transpose2(EE(1,1,itj),auxmat(1,1))
6216 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6217 vv(1)=pizda(1,1)+pizda(2,2)
6218 vv(2)=pizda(2,1)-pizda(1,2)
6219 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6220 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6222 C Explicit gradient in virtual-dihedral angles.
6223 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6224 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6225 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6226 vv(1)=pizda(1,1)+pizda(2,2)
6227 vv(2)=pizda(2,1)-pizda(1,2)
6228 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6229 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6230 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6231 C Cartesian gradient
6235 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6237 vv(1)=pizda(1,1)+pizda(2,2)
6238 vv(2)=pizda(2,1)-pizda(1,2)
6239 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6240 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6241 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6248 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6249 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6250 cd write (2,*) 'ijkl',i,j,k,l
6251 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6252 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6254 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6255 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6256 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6257 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6259 if (j.lt.nres-1) then
6266 if (l.lt.nres-1) then
6276 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6278 ggg1(ll)=eel5*g_contij(ll,1)
6279 ggg2(ll)=eel5*g_contij(ll,2)
6280 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6281 ghalf=0.5d0*ggg1(ll)
6283 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6284 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6285 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6286 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6287 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6288 ghalf=0.5d0*ggg2(ll)
6290 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6291 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6292 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6293 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6298 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6299 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6304 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6305 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6311 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6316 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6320 cd write (2,*) iii,g_corr5_loc(iii)
6324 cd write (2,*) 'ekont',ekont
6325 cd write (iout,*) 'eello5',ekont*eel5
6328 c--------------------------------------------------------------------------
6329 double precision function eello6(i,j,k,l,jj,kk)
6330 implicit real*8 (a-h,o-z)
6331 include 'DIMENSIONS'
6332 include 'DIMENSIONS.ZSCOPT'
6333 include 'COMMON.IOUNITS'
6334 include 'COMMON.CHAIN'
6335 include 'COMMON.DERIV'
6336 include 'COMMON.INTERACT'
6337 include 'COMMON.CONTACTS'
6338 include 'COMMON.TORSION'
6339 include 'COMMON.VAR'
6340 include 'COMMON.GEO'
6341 include 'COMMON.FFIELD'
6342 double precision ggg1(3),ggg2(3)
6343 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6348 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6356 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6357 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6361 derx(lll,kkk,iii)=0.0d0
6365 cd eij=facont_hb(jj,i)
6366 cd ekl=facont_hb(kk,k)
6372 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6373 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6374 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6375 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6376 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6377 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6379 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6380 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6381 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6382 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6383 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6384 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6388 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6390 C If turn contributions are considered, they will be handled separately.
6391 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6392 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6393 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6394 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6395 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6396 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6397 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6400 if (j.lt.nres-1) then
6407 if (l.lt.nres-1) then
6415 ggg1(ll)=eel6*g_contij(ll,1)
6416 ggg2(ll)=eel6*g_contij(ll,2)
6417 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6418 ghalf=0.5d0*ggg1(ll)
6420 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6421 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6422 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6423 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6424 ghalf=0.5d0*ggg2(ll)
6425 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6427 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6428 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6429 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6430 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6435 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6436 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6441 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6442 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6448 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6453 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6457 cd write (2,*) iii,g_corr6_loc(iii)
6461 cd write (2,*) 'ekont',ekont
6462 cd write (iout,*) 'eello6',ekont*eel6
6465 c--------------------------------------------------------------------------
6466 double precision function eello6_graph1(i,j,k,l,imat,swap)
6467 implicit real*8 (a-h,o-z)
6468 include 'DIMENSIONS'
6469 include 'DIMENSIONS.ZSCOPT'
6470 include 'COMMON.IOUNITS'
6471 include 'COMMON.CHAIN'
6472 include 'COMMON.DERIV'
6473 include 'COMMON.INTERACT'
6474 include 'COMMON.CONTACTS'
6475 include 'COMMON.TORSION'
6476 include 'COMMON.VAR'
6477 include 'COMMON.GEO'
6478 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6482 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6484 C Parallel Antiparallel C
6490 C \ j|/k\| / \ |/k\|l / C
6495 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6496 itk=itortyp(itype(k))
6497 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6498 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6499 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6500 call transpose2(EUgC(1,1,k),auxmat(1,1))
6501 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6502 vv1(1)=pizda1(1,1)-pizda1(2,2)
6503 vv1(2)=pizda1(1,2)+pizda1(2,1)
6504 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6505 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6506 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6507 s5=scalar2(vv(1),Dtobr2(1,i))
6508 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6509 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6510 if (.not. calc_grad) return
6511 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6512 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6513 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6514 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6515 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6516 & +scalar2(vv(1),Dtobr2der(1,i)))
6517 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6518 vv1(1)=pizda1(1,1)-pizda1(2,2)
6519 vv1(2)=pizda1(1,2)+pizda1(2,1)
6520 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6521 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6523 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6524 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6525 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6526 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6527 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6529 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6530 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6531 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6532 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6533 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6535 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6536 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6537 vv1(1)=pizda1(1,1)-pizda1(2,2)
6538 vv1(2)=pizda1(1,2)+pizda1(2,1)
6539 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6540 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6541 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6542 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6551 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6552 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6553 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6554 call transpose2(EUgC(1,1,k),auxmat(1,1))
6555 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6557 vv1(1)=pizda1(1,1)-pizda1(2,2)
6558 vv1(2)=pizda1(1,2)+pizda1(2,1)
6559 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6560 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6561 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6562 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6563 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6564 s5=scalar2(vv(1),Dtobr2(1,i))
6565 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6571 c----------------------------------------------------------------------------
6572 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6573 implicit real*8 (a-h,o-z)
6574 include 'DIMENSIONS'
6575 include 'DIMENSIONS.ZSCOPT'
6576 include 'COMMON.IOUNITS'
6577 include 'COMMON.CHAIN'
6578 include 'COMMON.DERIV'
6579 include 'COMMON.INTERACT'
6580 include 'COMMON.CONTACTS'
6581 include 'COMMON.TORSION'
6582 include 'COMMON.VAR'
6583 include 'COMMON.GEO'
6585 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6586 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6589 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6591 C Parallel Antiparallel C
6597 C \ j|/k\| \ |/k\|l C
6602 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6603 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6604 C AL 7/4/01 s1 would occur in the sixth-order moment,
6605 C but not in a cluster cumulant
6607 s1=dip(1,jj,i)*dip(1,kk,k)
6609 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6610 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6611 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6612 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6613 call transpose2(EUg(1,1,k),auxmat(1,1))
6614 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6615 vv(1)=pizda(1,1)-pizda(2,2)
6616 vv(2)=pizda(1,2)+pizda(2,1)
6617 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6618 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6620 eello6_graph2=-(s1+s2+s3+s4)
6622 eello6_graph2=-(s2+s3+s4)
6625 if (.not. calc_grad) return
6626 C Derivatives in gamma(i-1)
6629 s1=dipderg(1,jj,i)*dip(1,kk,k)
6631 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6632 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6633 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6634 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6636 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6638 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6640 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6642 C Derivatives in gamma(k-1)
6644 s1=dip(1,jj,i)*dipderg(1,kk,k)
6646 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6647 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6648 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6649 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6650 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6651 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6652 vv(1)=pizda(1,1)-pizda(2,2)
6653 vv(2)=pizda(1,2)+pizda(2,1)
6654 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6656 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6658 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6660 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6661 C Derivatives in gamma(j-1) or gamma(l-1)
6664 s1=dipderg(3,jj,i)*dip(1,kk,k)
6666 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6667 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6668 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6669 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6670 vv(1)=pizda(1,1)-pizda(2,2)
6671 vv(2)=pizda(1,2)+pizda(2,1)
6672 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6675 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6677 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6680 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6681 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6683 C Derivatives in gamma(l-1) or gamma(j-1)
6686 s1=dip(1,jj,i)*dipderg(3,kk,k)
6688 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6689 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6690 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6691 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6692 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6693 vv(1)=pizda(1,1)-pizda(2,2)
6694 vv(2)=pizda(1,2)+pizda(2,1)
6695 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6698 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6700 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6703 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6704 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6706 C Cartesian derivatives.
6708 write (2,*) 'In eello6_graph2'
6710 write (2,*) 'iii=',iii
6712 write (2,*) 'kkk=',kkk
6714 write (2,'(3(2f10.5),5x)')
6715 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6725 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6727 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6730 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6732 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6733 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6735 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6736 call transpose2(EUg(1,1,k),auxmat(1,1))
6737 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6739 vv(1)=pizda(1,1)-pizda(2,2)
6740 vv(2)=pizda(1,2)+pizda(2,1)
6741 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6742 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6744 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6746 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6749 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6751 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6758 c----------------------------------------------------------------------------
6759 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6760 implicit real*8 (a-h,o-z)
6761 include 'DIMENSIONS'
6762 include 'DIMENSIONS.ZSCOPT'
6763 include 'COMMON.IOUNITS'
6764 include 'COMMON.CHAIN'
6765 include 'COMMON.DERIV'
6766 include 'COMMON.INTERACT'
6767 include 'COMMON.CONTACTS'
6768 include 'COMMON.TORSION'
6769 include 'COMMON.VAR'
6770 include 'COMMON.GEO'
6771 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6773 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6775 C Parallel Antiparallel C
6781 C j|/k\| / |/k\|l / C
6786 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6788 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6789 C energy moment and not to the cluster cumulant.
6790 iti=itortyp(itype(i))
6791 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6792 itj1=itortyp(itype(j+1))
6796 itk=itortyp(itype(k))
6797 itk1=itortyp(itype(k+1))
6798 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6799 itl1=itortyp(itype(l+1))
6804 s1=dip(4,jj,i)*dip(4,kk,k)
6806 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6807 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6808 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6809 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6810 call transpose2(EE(1,1,itk),auxmat(1,1))
6811 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6812 vv(1)=pizda(1,1)+pizda(2,2)
6813 vv(2)=pizda(2,1)-pizda(1,2)
6814 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6815 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6817 eello6_graph3=-(s1+s2+s3+s4)
6819 eello6_graph3=-(s2+s3+s4)
6822 if (.not. calc_grad) return
6823 C Derivatives in gamma(k-1)
6824 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6825 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6826 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6827 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6828 C Derivatives in gamma(l-1)
6829 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6830 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6831 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6832 vv(1)=pizda(1,1)+pizda(2,2)
6833 vv(2)=pizda(2,1)-pizda(1,2)
6834 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6835 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6836 C Cartesian derivatives.
6842 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6844 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6847 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6849 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6850 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6852 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6853 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6855 vv(1)=pizda(1,1)+pizda(2,2)
6856 vv(2)=pizda(2,1)-pizda(1,2)
6857 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6859 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6861 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6864 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6866 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6868 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6874 c----------------------------------------------------------------------------
6875 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6876 implicit real*8 (a-h,o-z)
6877 include 'DIMENSIONS'
6878 include 'DIMENSIONS.ZSCOPT'
6879 include 'COMMON.IOUNITS'
6880 include 'COMMON.CHAIN'
6881 include 'COMMON.DERIV'
6882 include 'COMMON.INTERACT'
6883 include 'COMMON.CONTACTS'
6884 include 'COMMON.TORSION'
6885 include 'COMMON.VAR'
6886 include 'COMMON.GEO'
6887 include 'COMMON.FFIELD'
6888 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6889 & auxvec1(2),auxmat1(2,2)
6891 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6893 C Parallel Antiparallel C
6899 C \ j|/k\| \ |/k\|l C
6904 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6906 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6907 C energy moment and not to the cluster cumulant.
6908 cd write (2,*) 'eello_graph4: wturn6',wturn6
6909 iti=itortyp(itype(i))
6910 itj=itortyp(itype(j))
6911 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6912 itj1=itortyp(itype(j+1))
6916 itk=itortyp(itype(k))
6917 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6918 itk1=itortyp(itype(k+1))
6922 itl=itortyp(itype(l))
6923 if (l.lt.nres-1) then
6924 itl1=itortyp(itype(l+1))
6928 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6929 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6930 cd & ' itl',itl,' itl1',itl1
6933 s1=dip(3,jj,i)*dip(3,kk,k)
6935 s1=dip(2,jj,j)*dip(2,kk,l)
6938 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6939 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6941 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6942 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6944 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6945 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6947 call transpose2(EUg(1,1,k),auxmat(1,1))
6948 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6949 vv(1)=pizda(1,1)-pizda(2,2)
6950 vv(2)=pizda(2,1)+pizda(1,2)
6951 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6952 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6954 eello6_graph4=-(s1+s2+s3+s4)
6956 eello6_graph4=-(s2+s3+s4)
6958 if (.not. calc_grad) return
6959 C Derivatives in gamma(i-1)
6963 s1=dipderg(2,jj,i)*dip(3,kk,k)
6965 s1=dipderg(4,jj,j)*dip(2,kk,l)
6968 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6970 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6971 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6973 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6974 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6976 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6977 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6978 cd write (2,*) 'turn6 derivatives'
6980 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6982 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6986 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6988 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6992 C Derivatives in gamma(k-1)
6995 s1=dip(3,jj,i)*dipderg(2,kk,k)
6997 s1=dip(2,jj,j)*dipderg(4,kk,l)
7000 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7001 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7003 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7004 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7006 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7007 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7009 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7010 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7011 vv(1)=pizda(1,1)-pizda(2,2)
7012 vv(2)=pizda(2,1)+pizda(1,2)
7013 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7014 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7016 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7018 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7022 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7024 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7027 C Derivatives in gamma(j-1) or gamma(l-1)
7028 if (l.eq.j+1 .and. l.gt.1) then
7029 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7030 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7031 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7032 vv(1)=pizda(1,1)-pizda(2,2)
7033 vv(2)=pizda(2,1)+pizda(1,2)
7034 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7035 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7036 else if (j.gt.1) then
7037 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7038 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7039 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7040 vv(1)=pizda(1,1)-pizda(2,2)
7041 vv(2)=pizda(2,1)+pizda(1,2)
7042 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7043 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7044 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7046 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7049 C Cartesian derivatives.
7056 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7058 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7062 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7064 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7068 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7070 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7072 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7073 & b1(1,itj1),auxvec(1))
7074 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7076 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7077 & b1(1,itl1),auxvec(1))
7078 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7080 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7082 vv(1)=pizda(1,1)-pizda(2,2)
7083 vv(2)=pizda(2,1)+pizda(1,2)
7084 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7086 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7088 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7091 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7094 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7097 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7099 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7101 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7105 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7107 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7110 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7112 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7120 c----------------------------------------------------------------------------
7121 double precision function eello_turn6(i,jj,kk)
7122 implicit real*8 (a-h,o-z)
7123 include 'DIMENSIONS'
7124 include 'DIMENSIONS.ZSCOPT'
7125 include 'COMMON.IOUNITS'
7126 include 'COMMON.CHAIN'
7127 include 'COMMON.DERIV'
7128 include 'COMMON.INTERACT'
7129 include 'COMMON.CONTACTS'
7130 include 'COMMON.TORSION'
7131 include 'COMMON.VAR'
7132 include 'COMMON.GEO'
7133 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7134 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7136 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7137 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7138 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7139 C the respective energy moment and not to the cluster cumulant.
7144 iti=itortyp(itype(i))
7145 itk=itortyp(itype(k))
7146 itk1=itortyp(itype(k+1))
7147 itl=itortyp(itype(l))
7148 itj=itortyp(itype(j))
7149 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7150 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7151 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7156 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7158 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7162 derx_turn(lll,kkk,iii)=0.0d0
7169 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7171 cd write (2,*) 'eello6_5',eello6_5
7173 call transpose2(AEA(1,1,1),auxmat(1,1))
7174 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7175 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7176 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7180 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7181 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7182 s2 = scalar2(b1(1,itk),vtemp1(1))
7184 call transpose2(AEA(1,1,2),atemp(1,1))
7185 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7186 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7187 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7191 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7192 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7193 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7195 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7196 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7197 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7198 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7199 ss13 = scalar2(b1(1,itk),vtemp4(1))
7200 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7204 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7210 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7212 C Derivatives in gamma(i+2)
7214 call transpose2(AEA(1,1,1),auxmatd(1,1))
7215 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7216 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7217 call transpose2(AEAderg(1,1,2),atempd(1,1))
7218 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7219 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7223 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7224 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7225 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7231 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7232 C Derivatives in gamma(i+3)
7234 call transpose2(AEA(1,1,1),auxmatd(1,1))
7235 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7236 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7237 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7241 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7242 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7243 s2d = scalar2(b1(1,itk),vtemp1d(1))
7245 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7246 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7248 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7250 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7251 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7252 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7262 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7263 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7265 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7266 & -0.5d0*ekont*(s2d+s12d)
7268 C Derivatives in gamma(i+4)
7269 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7270 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7271 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7273 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7274 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7275 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7285 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7287 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7289 C Derivatives in gamma(i+5)
7291 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7292 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7293 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7297 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7298 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7299 s2d = scalar2(b1(1,itk),vtemp1d(1))
7301 call transpose2(AEA(1,1,2),atempd(1,1))
7302 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7303 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7307 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7308 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7310 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7311 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7312 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7322 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7323 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7325 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7326 & -0.5d0*ekont*(s2d+s12d)
7328 C Cartesian derivatives
7333 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7334 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7335 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7339 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7340 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7342 s2d = scalar2(b1(1,itk),vtemp1d(1))
7344 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7345 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7346 s8d = -(atempd(1,1)+atempd(2,2))*
7347 & scalar2(cc(1,1,itl),vtemp2(1))
7351 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7353 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7354 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7361 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7364 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7368 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7369 & - 0.5d0*(s8d+s12d)
7371 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7380 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7382 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7383 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7384 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7385 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7386 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7388 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7389 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7390 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7394 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7395 cd & 16*eel_turn6_num
7397 if (j.lt.nres-1) then
7404 if (l.lt.nres-1) then
7412 ggg1(ll)=eel_turn6*g_contij(ll,1)
7413 ggg2(ll)=eel_turn6*g_contij(ll,2)
7414 ghalf=0.5d0*ggg1(ll)
7416 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7417 & +ekont*derx_turn(ll,2,1)
7418 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7419 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7420 & +ekont*derx_turn(ll,4,1)
7421 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7422 ghalf=0.5d0*ggg2(ll)
7424 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7425 & +ekont*derx_turn(ll,2,2)
7426 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7427 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7428 & +ekont*derx_turn(ll,4,2)
7429 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7434 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7439 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7445 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7450 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7454 cd write (2,*) iii,g_corr6_loc(iii)
7457 eello_turn6=ekont*eel_turn6
7458 cd write (2,*) 'ekont',ekont
7459 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7462 crc-------------------------------------------------
7463 SUBROUTINE MATVEC2(A1,V1,V2)
7464 implicit real*8 (a-h,o-z)
7465 include 'DIMENSIONS'
7466 DIMENSION A1(2,2),V1(2),V2(2)
7470 c 3 VI=VI+A1(I,K)*V1(K)
7474 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7475 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7480 C---------------------------------------
7481 SUBROUTINE MATMAT2(A1,A2,A3)
7482 implicit real*8 (a-h,o-z)
7483 include 'DIMENSIONS'
7484 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7485 c DIMENSION AI3(2,2)
7489 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7495 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7496 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7497 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7498 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7506 c-------------------------------------------------------------------------
7507 double precision function scalar2(u,v)
7509 double precision u(2),v(2)
7512 scalar2=u(1)*v(1)+u(2)*v(2)
7516 C-----------------------------------------------------------------------------
7518 subroutine transpose2(a,at)
7520 double precision a(2,2),at(2,2)
7527 c--------------------------------------------------------------------------
7528 subroutine transpose(n,a,at)
7531 double precision a(n,n),at(n,n)
7539 C---------------------------------------------------------------------------
7540 subroutine prodmat3(a1,a2,kk,transp,prod)
7543 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7545 crc double precision auxmat(2,2),prod_(2,2)
7548 crc call transpose2(kk(1,1),auxmat(1,1))
7549 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7550 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7552 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7553 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7554 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7555 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7556 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7557 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7558 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7559 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7562 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7563 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7565 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7566 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7567 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7568 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7569 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7570 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7571 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7572 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7575 c call transpose2(a2(1,1),a2t(1,1))
7578 crc print *,((prod_(i,j),i=1,2),j=1,2)
7579 crc print *,((prod(i,j),i=1,2),j=1,2)
7583 C-----------------------------------------------------------------------------
7584 double precision function scalar(u,v)
7586 double precision u(3),v(3)