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