1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
160 if (isnan(etot).ne.0) energia(0)=1.0d+99
162 if (isnan(etot)) energia(0)=1.0d+99
167 idumm=proc_proc(etot,i)
169 call proc_proc(etot,i)
171 if(i.eq.1)energia(0)=1.0d+99
178 C Sum up the components of the Cartesian gradient.
183 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
184 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
186 & wstrain*ghpbc(j,i)+
187 & wcorr*fact(3)*gradcorr(j,i)+
188 & wel_loc*fact(2)*gel_loc(j,i)+
189 & wturn3*fact(2)*gcorr3_turn(j,i)+
190 & wturn4*fact(3)*gcorr4_turn(j,i)+
191 & wcorr5*fact(4)*gradcorr5(j,i)+
192 & wcorr6*fact(5)*gradcorr6(j,i)+
193 & wturn6*fact(5)*gcorr6_turn(j,i)+
194 & wsccor*fact(2)*gsccorc(j,i)
195 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
197 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
198 & wsccor*fact(2)*gsccorx(j,i)
203 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
204 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
206 & wcorr*fact(3)*gradcorr(j,i)+
207 & wel_loc*fact(2)*gel_loc(j,i)+
208 & wturn3*fact(2)*gcorr3_turn(j,i)+
209 & wturn4*fact(3)*gcorr4_turn(j,i)+
210 & wcorr5*fact(4)*gradcorr5(j,i)+
211 & wcorr6*fact(5)*gradcorr6(j,i)+
212 & wturn6*fact(5)*gcorr6_turn(j,i)+
213 & wsccor*fact(2)*gsccorc(j,i)
214 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
216 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
217 & wsccor*fact(1)*gsccorx(j,i)
224 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
225 & +wcorr5*fact(4)*g_corr5_loc(i)
226 & +wcorr6*fact(5)*g_corr6_loc(i)
227 & +wturn4*fact(3)*gel_loc_turn4(i)
228 & +wturn3*fact(2)*gel_loc_turn3(i)
229 & +wturn6*fact(5)*gel_loc_turn6(i)
230 & +wel_loc*fact(2)*gel_loc_loc(i)
231 c & +wsccor*fact(1)*gsccor_loc(i)
232 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
235 if (dyn_ss) call dyn_set_nss
238 C------------------------------------------------------------------------
239 subroutine enerprint(energia,fact)
240 implicit real*8 (a-h,o-z)
242 include 'DIMENSIONS.ZSCOPT'
243 include 'COMMON.IOUNITS'
244 include 'COMMON.FFIELD'
245 include 'COMMON.SBRIDGE'
246 double precision energia(0:max_ene),fact(6)
248 evdw=energia(1)+fact(6)*energia(21)
250 evdw2=energia(2)+energia(17)
262 eello_turn3=energia(8)
263 eello_turn4=energia(9)
264 eello_turn6=energia(10)
271 edihcnstr=energia(20)
274 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
276 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
277 & etors_d,wtor_d*fact(2),ehpb,wstrain,
278 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
279 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
280 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
281 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
282 10 format (/'Virtual-chain energies:'//
283 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
284 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
285 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
286 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
287 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
288 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
289 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
290 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
291 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
292 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
293 & ' (SS bridges & dist. cnstr.)'/
294 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
297 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
298 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
299 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
300 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
301 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
302 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
303 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
304 & 'ETOT= ',1pE16.6,' (total)')
306 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
307 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
308 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
309 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
310 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
311 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
312 & edihcnstr,ebr*nss,etot
313 10 format (/'Virtual-chain energies:'//
314 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
315 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
316 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
317 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
318 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
319 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
320 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
321 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
322 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
323 & ' (SS bridges & dist. cnstr.)'/
324 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
327 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
328 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
329 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
330 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
331 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
332 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
333 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
334 & 'ETOT= ',1pE16.6,' (total)')
338 C-----------------------------------------------------------------------
339 subroutine elj(evdw,evdw_t)
341 C This subroutine calculates the interaction energy of nonbonded side chains
342 C assuming the LJ potential of interaction.
344 implicit real*8 (a-h,o-z)
346 include 'DIMENSIONS.ZSCOPT'
347 include "DIMENSIONS.COMPAR"
348 parameter (accur=1.0d-10)
351 include 'COMMON.LOCAL'
352 include 'COMMON.CHAIN'
353 include 'COMMON.DERIV'
354 include 'COMMON.INTERACT'
355 include 'COMMON.TORSION'
356 include 'COMMON.ENEPS'
357 include 'COMMON.SBRIDGE'
358 include 'COMMON.NAMES'
359 include 'COMMON.IOUNITS'
360 include 'COMMON.CONTACTS'
364 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
368 eneps_temp(j,i)=0.0d0
377 if (itypi.eq.ntyp1) cycle
378 itypi1=iabs(itype(i+1))
385 C Calculate SC interaction energy.
388 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
389 cd & 'iend=',iend(i,iint)
390 do j=istart(i,iint),iend(i,iint)
392 if (itypj.eq.ntyp1) cycle
396 C Change 12/1/95 to calculate four-body interactions
397 rij=xj*xj+yj*yj+zj*zj
399 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
400 eps0ij=eps(itypi,itypj)
402 e1=fac*fac*aa(itypi,itypj)
403 e2=fac*bb(itypi,itypj)
405 ij=icant(itypi,itypj)
407 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
408 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
411 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
412 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
413 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
414 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
415 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
416 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
417 if (bb(itypi,itypj).gt.0.0d0) then
424 C Calculate the components of the gradient in DC and X
426 fac=-rrij*(e1+evdwij)
431 gvdwx(k,i)=gvdwx(k,i)-gg(k)
432 gvdwx(k,j)=gvdwx(k,j)+gg(k)
436 gvdwc(l,k)=gvdwc(l,k)+gg(l)
441 C 12/1/95, revised on 5/20/97
443 C Calculate the contact function. The ith column of the array JCONT will
444 C contain the numbers of atoms that make contacts with the atom I (of numbers
445 C greater than I). The arrays FACONT and GACONT will contain the values of
446 C the contact function and its derivative.
448 C Uncomment next line, if the correlation interactions include EVDW explicitly.
449 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
450 C Uncomment next line, if the correlation interactions are contact function only
451 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
453 sigij=sigma(itypi,itypj)
454 r0ij=rs0(itypi,itypj)
456 C Check whether the SC's are not too far to make a contact.
459 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
460 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
462 if (fcont.gt.0.0D0) then
463 C If the SC-SC distance if close to sigma, apply spline.
464 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
465 cAdam & fcont1,fprimcont1)
466 cAdam fcont1=1.0d0-fcont1
467 cAdam if (fcont1.gt.0.0d0) then
468 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
469 cAdam fcont=fcont*fcont1
471 C Uncomment following 4 lines to have the geometric average of the epsilon0's
472 cga eps0ij=1.0d0/dsqrt(eps0ij)
474 cga gg(k)=gg(k)*eps0ij
476 cga eps0ij=-evdwij*eps0ij
477 C Uncomment for AL's type of SC correlation interactions.
479 num_conti=num_conti+1
481 facont(num_conti,i)=fcont*eps0ij
482 fprimcont=eps0ij*fprimcont/rij
484 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
485 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
486 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
487 C Uncomment following 3 lines for Skolnick's type of SC correlation.
488 gacont(1,num_conti,i)=-fprimcont*xj
489 gacont(2,num_conti,i)=-fprimcont*yj
490 gacont(3,num_conti,i)=-fprimcont*zj
491 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
492 cd write (iout,'(2i3,3f10.5)')
493 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
499 num_cont(i)=num_conti
504 gvdwc(j,i)=expon*gvdwc(j,i)
505 gvdwx(j,i)=expon*gvdwx(j,i)
509 C******************************************************************************
513 C To save time, the factor of EXPON has been extracted from ALL components
514 C of GVDWC and GRADX. Remember to multiply them by this factor before further
517 C******************************************************************************
520 C-----------------------------------------------------------------------------
521 subroutine eljk(evdw,evdw_t)
523 C This subroutine calculates the interaction energy of nonbonded side chains
524 C assuming the LJK potential of interaction.
526 implicit real*8 (a-h,o-z)
528 include 'DIMENSIONS.ZSCOPT'
529 include "DIMENSIONS.COMPAR"
532 include 'COMMON.LOCAL'
533 include 'COMMON.CHAIN'
534 include 'COMMON.DERIV'
535 include 'COMMON.INTERACT'
536 include 'COMMON.ENEPS'
537 include 'COMMON.IOUNITS'
538 include 'COMMON.NAMES'
543 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
546 eneps_temp(j,i)=0.0d0
553 if (itypi.eq.ntyp1) cycle
554 itypi1=iabs(itype(i+1))
559 C Calculate SC interaction energy.
562 do j=istart(i,iint),iend(i,iint)
564 if (itypj.eq.ntyp1) cycle
568 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
570 e_augm=augm(itypi,itypj)*fac_augm
573 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
574 fac=r_shift_inv**expon
575 e1=fac*fac*aa(itypi,itypj)
576 e2=fac*bb(itypi,itypj)
578 ij=icant(itypi,itypj)
579 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
580 & /dabs(eps(itypi,itypj))
581 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
582 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
583 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
584 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
585 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
586 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
587 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
588 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
589 if (bb(itypi,itypj).gt.0.0d0) then
596 C Calculate the components of the gradient in DC and X
598 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
603 gvdwx(k,i)=gvdwx(k,i)-gg(k)
604 gvdwx(k,j)=gvdwx(k,j)+gg(k)
608 gvdwc(l,k)=gvdwc(l,k)+gg(l)
618 gvdwc(j,i)=expon*gvdwc(j,i)
619 gvdwx(j,i)=expon*gvdwx(j,i)
625 C-----------------------------------------------------------------------------
626 subroutine ebp(evdw,evdw_t)
628 C This subroutine calculates the interaction energy of nonbonded side chains
629 C assuming the Berne-Pechukas potential of interaction.
631 implicit real*8 (a-h,o-z)
633 include 'DIMENSIONS.ZSCOPT'
634 include "DIMENSIONS.COMPAR"
637 include 'COMMON.LOCAL'
638 include 'COMMON.CHAIN'
639 include 'COMMON.DERIV'
640 include 'COMMON.NAMES'
641 include 'COMMON.INTERACT'
642 include 'COMMON.ENEPS'
643 include 'COMMON.IOUNITS'
644 include 'COMMON.CALC'
646 c double precision rrsave(maxdim)
652 eneps_temp(j,i)=0.0d0
657 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
658 c if (icall.eq.0) then
666 if (itypi.eq.ntyp1) cycle
667 itypi1=iabs(itype(i+1))
671 dxi=dc_norm(1,nres+i)
672 dyi=dc_norm(2,nres+i)
673 dzi=dc_norm(3,nres+i)
674 dsci_inv=vbld_inv(i+nres)
676 C Calculate SC interaction energy.
679 do j=istart(i,iint),iend(i,iint)
682 if (itypj.eq.ntyp1) cycle
683 dscj_inv=vbld_inv(j+nres)
684 chi1=chi(itypi,itypj)
685 chi2=chi(itypj,itypi)
692 alf12=0.5D0*(alf1+alf2)
693 C For diagnostics only!!!
706 dxj=dc_norm(1,nres+j)
707 dyj=dc_norm(2,nres+j)
708 dzj=dc_norm(3,nres+j)
709 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
710 cd if (icall.eq.0) then
716 C Calculate the angle-dependent terms of energy & contributions to derivatives.
718 C Calculate whole angle-dependent part of epsilon and contributions
720 fac=(rrij*sigsq)**expon2
721 e1=fac*fac*aa(itypi,itypj)
722 e2=fac*bb(itypi,itypj)
723 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
724 eps2der=evdwij*eps3rt
725 eps3der=evdwij*eps2rt
726 evdwij=evdwij*eps2rt*eps3rt
727 ij=icant(itypi,itypj)
728 aux=eps1*eps2rt**2*eps3rt**2
729 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
730 & /dabs(eps(itypi,itypj))
731 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
732 if (bb(itypi,itypj).gt.0.0d0) then
739 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
740 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
741 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
742 & restyp(itypi),i,restyp(itypj),j,
743 & epsi,sigm,chi1,chi2,chip1,chip2,
744 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
745 & om1,om2,om12,1.0D0/dsqrt(rrij),
748 C Calculate gradient components.
749 e1=e1*eps1*eps2rt**2*eps3rt**2
750 fac=-expon*(e1+evdwij)
753 C Calculate radial part of the gradient
757 C Calculate the angular part of the gradient and sum add the contributions
758 C to the appropriate components of the Cartesian gradient.
767 C-----------------------------------------------------------------------------
768 subroutine egb(evdw,evdw_t)
770 C This subroutine calculates the interaction energy of nonbonded side chains
771 C assuming the Gay-Berne potential of interaction.
773 implicit real*8 (a-h,o-z)
775 include 'DIMENSIONS.ZSCOPT'
776 include "DIMENSIONS.COMPAR"
779 include 'COMMON.LOCAL'
780 include 'COMMON.CHAIN'
781 include 'COMMON.DERIV'
782 include 'COMMON.NAMES'
783 include 'COMMON.INTERACT'
784 include 'COMMON.ENEPS'
785 include 'COMMON.IOUNITS'
786 include 'COMMON.CALC'
787 include 'COMMON.SBRIDGE'
794 eneps_temp(j,i)=0.0d0
797 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
801 c if (icall.gt.0) lprn=.true.
805 if (itypi.eq.ntyp1) cycle
806 itypi1=iabs(itype(i+1))
810 dxi=dc_norm(1,nres+i)
811 dyi=dc_norm(2,nres+i)
812 dzi=dc_norm(3,nres+i)
813 dsci_inv=vbld_inv(i+nres)
815 C Calculate SC interaction energy.
818 do j=istart(i,iint),iend(i,iint)
819 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
820 call dyn_ssbond_ene(i,j,evdwij)
822 write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
823 & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
824 C triple bond artifac removal
825 do k=j+1,iend(i,iint)
826 C search over all next residues
827 if (dyn_ss_mask(k)) then
828 C check if they are cysteins
829 C write(iout,*) 'k=',k
830 call triple_ssbond_ene(i,j,k,evdwij)
831 C call the energy function that removes the artifical triple disulfide
832 C bond the soubroutine is located in ssMD.F
834 write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
835 & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
841 if (itypj.eq.ntyp1) cycle
842 dscj_inv=vbld_inv(j+nres)
843 sig0ij=sigma(itypi,itypj)
844 chi1=chi(itypi,itypj)
845 chi2=chi(itypj,itypi)
852 alf12=0.5D0*(alf1+alf2)
853 C For diagnostics only!!!
866 dxj=dc_norm(1,nres+j)
867 dyj=dc_norm(2,nres+j)
868 dzj=dc_norm(3,nres+j)
869 c write (iout,*) i,j,xj,yj,zj
870 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
872 C Calculate angle-dependent terms of energy and contributions to their
876 sig=sig0ij*dsqrt(sigsq)
877 rij_shift=1.0D0/rij-sig+sig0ij
878 C I hate to put IF's in the loops, but here don't have another choice!!!!
879 if (rij_shift.le.0.0D0) then
884 c---------------------------------------------------------------
885 rij_shift=1.0D0/rij_shift
887 e1=fac*fac*aa(itypi,itypj)
888 e2=fac*bb(itypi,itypj)
889 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
890 eps2der=evdwij*eps3rt
891 eps3der=evdwij*eps2rt
892 evdwij=evdwij*eps2rt*eps3rt
893 if (bb(itypi,itypj).gt.0) then
898 ij=icant(itypi,itypj)
899 aux=eps1*eps2rt**2*eps3rt**2
900 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
901 & /dabs(eps(itypi,itypj))
902 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
903 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
904 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
905 c & aux*e2/eps(itypi,itypj)
907 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
908 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
910 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
911 & restyp(itypi),i,restyp(itypj),j,
912 & epsi,sigm,chi1,chi2,chip1,chip2,
913 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
914 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
916 write (iout,*) "partial sum", evdw, evdw_t
920 C Calculate gradient components.
921 e1=e1*eps1*eps2rt**2*eps3rt**2
922 fac=-expon*(e1+evdwij)*rij_shift
925 C Calculate the radial part of the gradient
929 C Calculate angular part of the gradient.
932 write(iout,*) "partial sum", evdw, evdw_t
939 C-----------------------------------------------------------------------------
940 subroutine egbv(evdw,evdw_t)
942 C This subroutine calculates the interaction energy of nonbonded side chains
943 C assuming the Gay-Berne-Vorobjev potential of interaction.
945 implicit real*8 (a-h,o-z)
947 include 'DIMENSIONS.ZSCOPT'
948 include "DIMENSIONS.COMPAR"
951 include 'COMMON.LOCAL'
952 include 'COMMON.CHAIN'
953 include 'COMMON.DERIV'
954 include 'COMMON.NAMES'
955 include 'COMMON.INTERACT'
956 include 'COMMON.ENEPS'
957 include 'COMMON.IOUNITS'
958 include 'COMMON.CALC'
965 eneps_temp(j,i)=0.0d0
970 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
973 c if (icall.gt.0) lprn=.true.
977 if (itypi.eq.ntyp1) cycle
978 itypi1=iabs(itype(i+1))
982 dxi=dc_norm(1,nres+i)
983 dyi=dc_norm(2,nres+i)
984 dzi=dc_norm(3,nres+i)
985 dsci_inv=vbld_inv(i+nres)
987 C Calculate SC interaction energy.
990 do j=istart(i,iint),iend(i,iint)
993 if (itypj.eq.ntyp1) cycle
994 dscj_inv=vbld_inv(j+nres)
995 sig0ij=sigma(itypi,itypj)
997 chi1=chi(itypi,itypj)
998 chi2=chi(itypj,itypi)
1005 alf12=0.5D0*(alf1+alf2)
1006 C For diagnostics only!!!
1019 dxj=dc_norm(1,nres+j)
1020 dyj=dc_norm(2,nres+j)
1021 dzj=dc_norm(3,nres+j)
1022 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1024 C Calculate angle-dependent terms of energy and contributions to their
1028 sig=sig0ij*dsqrt(sigsq)
1029 rij_shift=1.0D0/rij-sig+r0ij
1030 C I hate to put IF's in the loops, but here don't have another choice!!!!
1031 if (rij_shift.le.0.0D0) then
1036 c---------------------------------------------------------------
1037 rij_shift=1.0D0/rij_shift
1038 fac=rij_shift**expon
1039 e1=fac*fac*aa(itypi,itypj)
1040 e2=fac*bb(itypi,itypj)
1041 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1042 eps2der=evdwij*eps3rt
1043 eps3der=evdwij*eps2rt
1044 fac_augm=rrij**expon
1045 e_augm=augm(itypi,itypj)*fac_augm
1046 evdwij=evdwij*eps2rt*eps3rt
1047 if (bb(itypi,itypj).gt.0.0d0) then
1048 evdw=evdw+evdwij+e_augm
1050 evdw_t=evdw_t+evdwij+e_augm
1052 ij=icant(itypi,itypj)
1053 aux=eps1*eps2rt**2*eps3rt**2
1054 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1055 & /dabs(eps(itypi,itypj))
1056 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1057 c eneps_temp(ij)=eneps_temp(ij)
1058 c & +(evdwij+e_augm)/eps(itypi,itypj)
1060 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1061 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1062 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1063 c & restyp(itypi),i,restyp(itypj),j,
1064 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1065 c & chi1,chi2,chip1,chip2,
1066 c & eps1,eps2rt**2,eps3rt**2,
1067 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1071 C Calculate gradient components.
1072 e1=e1*eps1*eps2rt**2*eps3rt**2
1073 fac=-expon*(e1+evdwij)*rij_shift
1075 fac=rij*fac-2*expon*rrij*e_augm
1076 C Calculate the radial part of the gradient
1080 C Calculate angular part of the gradient.
1088 C-----------------------------------------------------------------------------
1089 subroutine sc_angular
1090 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1091 C om12. Called by ebp, egb, and egbv.
1093 include 'COMMON.CALC'
1097 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1098 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1099 om12=dxi*dxj+dyi*dyj+dzi*dzj
1101 C Calculate eps1(om12) and its derivative in om12
1102 faceps1=1.0D0-om12*chiom12
1103 faceps1_inv=1.0D0/faceps1
1104 eps1=dsqrt(faceps1_inv)
1105 C Following variable is eps1*deps1/dom12
1106 eps1_om12=faceps1_inv*chiom12
1107 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1112 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1113 sigsq=1.0D0-facsig*faceps1_inv
1114 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1115 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1116 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1117 C Calculate eps2 and its derivatives in om1, om2, and om12.
1120 chipom12=chip12*om12
1121 facp=1.0D0-om12*chipom12
1123 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1124 C Following variable is the square root of eps2
1125 eps2rt=1.0D0-facp1*facp_inv
1126 C Following three variables are the derivatives of the square root of eps
1127 C in om1, om2, and om12.
1128 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1129 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1130 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1131 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1132 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1133 C Calculate whole angle-dependent part of epsilon and contributions
1134 C to its derivatives
1137 C----------------------------------------------------------------------------
1139 implicit real*8 (a-h,o-z)
1140 include 'DIMENSIONS'
1141 include 'DIMENSIONS.ZSCOPT'
1142 include 'COMMON.CHAIN'
1143 include 'COMMON.DERIV'
1144 include 'COMMON.CALC'
1145 double precision dcosom1(3),dcosom2(3)
1146 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1147 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1148 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1149 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1151 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1152 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1155 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1158 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1159 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1160 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1161 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1162 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1163 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1166 C Calculate the components of the gradient in DC and X
1170 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1175 c------------------------------------------------------------------------------
1176 subroutine vec_and_deriv
1177 implicit real*8 (a-h,o-z)
1178 include 'DIMENSIONS'
1179 include 'DIMENSIONS.ZSCOPT'
1180 include 'COMMON.IOUNITS'
1181 include 'COMMON.GEO'
1182 include 'COMMON.VAR'
1183 include 'COMMON.LOCAL'
1184 include 'COMMON.CHAIN'
1185 include 'COMMON.VECTORS'
1186 include 'COMMON.DERIV'
1187 include 'COMMON.INTERACT'
1188 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1189 C Compute the local reference systems. For reference system (i), the
1190 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1191 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1193 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1194 if (i.eq.nres-1) then
1195 C Case of the last full residue
1196 C Compute the Z-axis
1197 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1198 costh=dcos(pi-theta(nres))
1199 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1204 C Compute the derivatives of uz
1206 uzder(2,1,1)=-dc_norm(3,i-1)
1207 uzder(3,1,1)= dc_norm(2,i-1)
1208 uzder(1,2,1)= dc_norm(3,i-1)
1210 uzder(3,2,1)=-dc_norm(1,i-1)
1211 uzder(1,3,1)=-dc_norm(2,i-1)
1212 uzder(2,3,1)= dc_norm(1,i-1)
1215 uzder(2,1,2)= dc_norm(3,i)
1216 uzder(3,1,2)=-dc_norm(2,i)
1217 uzder(1,2,2)=-dc_norm(3,i)
1219 uzder(3,2,2)= dc_norm(1,i)
1220 uzder(1,3,2)= dc_norm(2,i)
1221 uzder(2,3,2)=-dc_norm(1,i)
1224 C Compute the Y-axis
1227 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1230 C Compute the derivatives of uy
1233 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1234 & -dc_norm(k,i)*dc_norm(j,i-1)
1235 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1237 uyder(j,j,1)=uyder(j,j,1)-costh
1238 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1243 uygrad(l,k,j,i)=uyder(l,k,j)
1244 uzgrad(l,k,j,i)=uzder(l,k,j)
1248 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1249 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1250 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1251 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1255 C Compute the Z-axis
1256 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1257 costh=dcos(pi-theta(i+2))
1258 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1263 C Compute the derivatives of uz
1265 uzder(2,1,1)=-dc_norm(3,i+1)
1266 uzder(3,1,1)= dc_norm(2,i+1)
1267 uzder(1,2,1)= dc_norm(3,i+1)
1269 uzder(3,2,1)=-dc_norm(1,i+1)
1270 uzder(1,3,1)=-dc_norm(2,i+1)
1271 uzder(2,3,1)= dc_norm(1,i+1)
1274 uzder(2,1,2)= dc_norm(3,i)
1275 uzder(3,1,2)=-dc_norm(2,i)
1276 uzder(1,2,2)=-dc_norm(3,i)
1278 uzder(3,2,2)= dc_norm(1,i)
1279 uzder(1,3,2)= dc_norm(2,i)
1280 uzder(2,3,2)=-dc_norm(1,i)
1283 C Compute the Y-axis
1286 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1289 C Compute the derivatives of uy
1292 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1293 & -dc_norm(k,i)*dc_norm(j,i+1)
1294 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1296 uyder(j,j,1)=uyder(j,j,1)-costh
1297 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1302 uygrad(l,k,j,i)=uyder(l,k,j)
1303 uzgrad(l,k,j,i)=uzder(l,k,j)
1307 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1308 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1309 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1310 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1316 vbld_inv_temp(1)=vbld_inv(i+1)
1317 if (i.lt.nres-1) then
1318 vbld_inv_temp(2)=vbld_inv(i+2)
1320 vbld_inv_temp(2)=vbld_inv(i)
1325 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1326 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1334 C-----------------------------------------------------------------------------
1335 subroutine vec_and_deriv_test
1336 implicit real*8 (a-h,o-z)
1337 include 'DIMENSIONS'
1338 include 'DIMENSIONS.ZSCOPT'
1339 include 'COMMON.IOUNITS'
1340 include 'COMMON.GEO'
1341 include 'COMMON.VAR'
1342 include 'COMMON.LOCAL'
1343 include 'COMMON.CHAIN'
1344 include 'COMMON.VECTORS'
1345 dimension uyder(3,3,2),uzder(3,3,2)
1346 C Compute the local reference systems. For reference system (i), the
1347 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1348 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1350 if (i.eq.nres-1) then
1351 C Case of the last full residue
1352 C Compute the Z-axis
1353 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1354 costh=dcos(pi-theta(nres))
1355 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1356 c write (iout,*) 'fac',fac,
1357 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1358 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1362 C Compute the derivatives of uz
1364 uzder(2,1,1)=-dc_norm(3,i-1)
1365 uzder(3,1,1)= dc_norm(2,i-1)
1366 uzder(1,2,1)= dc_norm(3,i-1)
1368 uzder(3,2,1)=-dc_norm(1,i-1)
1369 uzder(1,3,1)=-dc_norm(2,i-1)
1370 uzder(2,3,1)= dc_norm(1,i-1)
1373 uzder(2,1,2)= dc_norm(3,i)
1374 uzder(3,1,2)=-dc_norm(2,i)
1375 uzder(1,2,2)=-dc_norm(3,i)
1377 uzder(3,2,2)= dc_norm(1,i)
1378 uzder(1,3,2)= dc_norm(2,i)
1379 uzder(2,3,2)=-dc_norm(1,i)
1381 C Compute the Y-axis
1383 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1386 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1387 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1388 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1390 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1393 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1394 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1397 c write (iout,*) 'facy',facy,
1398 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1399 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1401 uy(k,i)=facy*uy(k,i)
1403 C Compute the derivatives of uy
1406 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1407 & -dc_norm(k,i)*dc_norm(j,i-1)
1408 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1410 c uyder(j,j,1)=uyder(j,j,1)-costh
1411 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1412 uyder(j,j,1)=uyder(j,j,1)
1413 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1414 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1420 uygrad(l,k,j,i)=uyder(l,k,j)
1421 uzgrad(l,k,j,i)=uzder(l,k,j)
1425 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1426 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1427 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1428 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1431 C Compute the Z-axis
1432 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1433 costh=dcos(pi-theta(i+2))
1434 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1435 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1439 C Compute the derivatives of uz
1441 uzder(2,1,1)=-dc_norm(3,i+1)
1442 uzder(3,1,1)= dc_norm(2,i+1)
1443 uzder(1,2,1)= dc_norm(3,i+1)
1445 uzder(3,2,1)=-dc_norm(1,i+1)
1446 uzder(1,3,1)=-dc_norm(2,i+1)
1447 uzder(2,3,1)= dc_norm(1,i+1)
1450 uzder(2,1,2)= dc_norm(3,i)
1451 uzder(3,1,2)=-dc_norm(2,i)
1452 uzder(1,2,2)=-dc_norm(3,i)
1454 uzder(3,2,2)= dc_norm(1,i)
1455 uzder(1,3,2)= dc_norm(2,i)
1456 uzder(2,3,2)=-dc_norm(1,i)
1458 C Compute the Y-axis
1460 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1461 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1462 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1464 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1467 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1468 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1471 c write (iout,*) 'facy',facy,
1472 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1473 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1475 uy(k,i)=facy*uy(k,i)
1477 C Compute the derivatives of uy
1480 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1481 & -dc_norm(k,i)*dc_norm(j,i+1)
1482 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1484 c uyder(j,j,1)=uyder(j,j,1)-costh
1485 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1486 uyder(j,j,1)=uyder(j,j,1)
1487 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1488 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1494 uygrad(l,k,j,i)=uyder(l,k,j)
1495 uzgrad(l,k,j,i)=uzder(l,k,j)
1499 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1500 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1501 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1502 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1509 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1510 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1517 C-----------------------------------------------------------------------------
1518 subroutine check_vecgrad
1519 implicit real*8 (a-h,o-z)
1520 include 'DIMENSIONS'
1521 include 'DIMENSIONS.ZSCOPT'
1522 include 'COMMON.IOUNITS'
1523 include 'COMMON.GEO'
1524 include 'COMMON.VAR'
1525 include 'COMMON.LOCAL'
1526 include 'COMMON.CHAIN'
1527 include 'COMMON.VECTORS'
1528 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1529 dimension uyt(3,maxres),uzt(3,maxres)
1530 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1531 double precision delta /1.0d-7/
1534 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1535 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1536 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1537 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1538 cd & (dc_norm(if90,i),if90=1,3)
1539 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1540 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1541 cd write(iout,'(a)')
1547 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1548 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1561 cd write (iout,*) 'i=',i
1563 erij(k)=dc_norm(k,i)
1567 dc_norm(k,i)=erij(k)
1569 dc_norm(j,i)=dc_norm(j,i)+delta
1570 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1572 c dc_norm(k,i)=dc_norm(k,i)/fac
1574 c write (iout,*) (dc_norm(k,i),k=1,3)
1575 c write (iout,*) (erij(k),k=1,3)
1578 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1579 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1580 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1581 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1583 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1584 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1585 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1588 dc_norm(k,i)=erij(k)
1591 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1592 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1593 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1594 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1595 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1596 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1597 cd write (iout,'(a)')
1602 C--------------------------------------------------------------------------
1603 subroutine set_matrices
1604 implicit real*8 (a-h,o-z)
1605 include 'DIMENSIONS'
1606 include 'DIMENSIONS.ZSCOPT'
1607 include 'COMMON.IOUNITS'
1608 include 'COMMON.GEO'
1609 include 'COMMON.VAR'
1610 include 'COMMON.LOCAL'
1611 include 'COMMON.CHAIN'
1612 include 'COMMON.DERIV'
1613 include 'COMMON.INTERACT'
1614 include 'COMMON.CONTACTS'
1615 include 'COMMON.TORSION'
1616 include 'COMMON.VECTORS'
1617 include 'COMMON.FFIELD'
1618 double precision auxvec(2),auxmat(2,2)
1620 C Compute the virtual-bond-torsional-angle dependent quantities needed
1621 C to calculate the el-loc multibody terms of various order.
1624 if (i .lt. nres+1) then
1661 if (i .gt. 3 .and. i .lt. nres+1) then
1662 obrot_der(1,i-2)=-sin1
1663 obrot_der(2,i-2)= cos1
1664 Ugder(1,1,i-2)= sin1
1665 Ugder(1,2,i-2)=-cos1
1666 Ugder(2,1,i-2)=-cos1
1667 Ugder(2,2,i-2)=-sin1
1670 obrot2_der(1,i-2)=-dwasin2
1671 obrot2_der(2,i-2)= dwacos2
1672 Ug2der(1,1,i-2)= dwasin2
1673 Ug2der(1,2,i-2)=-dwacos2
1674 Ug2der(2,1,i-2)=-dwacos2
1675 Ug2der(2,2,i-2)=-dwasin2
1677 obrot_der(1,i-2)=0.0d0
1678 obrot_der(2,i-2)=0.0d0
1679 Ugder(1,1,i-2)=0.0d0
1680 Ugder(1,2,i-2)=0.0d0
1681 Ugder(2,1,i-2)=0.0d0
1682 Ugder(2,2,i-2)=0.0d0
1683 obrot2_der(1,i-2)=0.0d0
1684 obrot2_der(2,i-2)=0.0d0
1685 Ug2der(1,1,i-2)=0.0d0
1686 Ug2der(1,2,i-2)=0.0d0
1687 Ug2der(2,1,i-2)=0.0d0
1688 Ug2der(2,2,i-2)=0.0d0
1690 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1691 if (itype(i-2).le.ntyp) then
1692 iti = itortyp(itype(i-2))
1699 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1700 if (itype(i-1).le.ntyp) then
1701 iti1 = itortyp(itype(i-1))
1708 cd write (iout,*) '*******i',i,' iti1',iti
1709 cd write (iout,*) 'b1',b1(:,iti)
1710 cd write (iout,*) 'b2',b2(:,iti)
1711 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1712 c print *,"itilde1 i iti iti1",i,iti,iti1
1713 if (i .gt. iatel_s+2) then
1714 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1715 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1716 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1717 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1718 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1719 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1720 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1730 DtUg2(l,k,i-2)=0.0d0
1734 c print *,"itilde2 i iti iti1",i,iti,iti1
1735 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1736 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1737 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1738 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1739 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1740 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1741 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1742 c print *,"itilde3 i iti iti1",i,iti,iti1
1744 muder(k,i-2)=Ub2der(k,i-2)
1746 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1747 if (itype(i-1).le.ntyp) then
1748 iti1 = itortyp(itype(i-1))
1756 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1758 C Vectors and matrices dependent on a single virtual-bond dihedral.
1759 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1760 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1761 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1762 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1763 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1764 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1765 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1766 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1767 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1768 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1769 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1771 C Matrices dependent on two consecutive virtual-bond dihedrals.
1772 C The order of matrices is from left to right.
1774 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1775 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1776 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1777 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1778 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1779 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1780 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1781 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1784 cd iti = itortyp(itype(i))
1787 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1788 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1793 C--------------------------------------------------------------------------
1794 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1796 C This subroutine calculates the average interaction energy and its gradient
1797 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1798 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1799 C The potential depends both on the distance of peptide-group centers and on
1800 C the orientation of the CA-CA virtual bonds.
1802 implicit real*8 (a-h,o-z)
1803 include 'DIMENSIONS'
1804 include 'DIMENSIONS.ZSCOPT'
1805 include 'COMMON.CONTROL'
1806 include 'COMMON.IOUNITS'
1807 include 'COMMON.GEO'
1808 include 'COMMON.VAR'
1809 include 'COMMON.LOCAL'
1810 include 'COMMON.CHAIN'
1811 include 'COMMON.DERIV'
1812 include 'COMMON.INTERACT'
1813 include 'COMMON.CONTACTS'
1814 include 'COMMON.TORSION'
1815 include 'COMMON.VECTORS'
1816 include 'COMMON.FFIELD'
1817 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1818 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1819 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1820 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1821 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1822 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1823 double precision scal_el /0.5d0/
1825 C 13-go grudnia roku pamietnego...
1826 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1827 & 0.0d0,1.0d0,0.0d0,
1828 & 0.0d0,0.0d0,1.0d0/
1829 cd write(iout,*) 'In EELEC'
1831 cd write(iout,*) 'Type',i
1832 cd write(iout,*) 'B1',B1(:,i)
1833 cd write(iout,*) 'B2',B2(:,i)
1834 cd write(iout,*) 'CC',CC(:,:,i)
1835 cd write(iout,*) 'DD',DD(:,:,i)
1836 cd write(iout,*) 'EE',EE(:,:,i)
1838 cd call check_vecgrad
1840 if (icheckgrad.eq.1) then
1842 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1844 dc_norm(k,i)=dc(k,i)*fac
1846 c write (iout,*) 'i',i,' fac',fac
1849 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1850 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1851 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1852 cd if (wel_loc.gt.0.0d0) then
1853 if (icheckgrad.eq.1) then
1854 call vec_and_deriv_test
1861 cd write (iout,*) 'i=',i
1863 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1866 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1867 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1880 cd print '(a)','Enter EELEC'
1881 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1883 gel_loc_loc(i)=0.0d0
1886 do i=iatel_s,iatel_e
1887 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1888 if (itel(i).eq.0) goto 1215
1892 dx_normi=dc_norm(1,i)
1893 dy_normi=dc_norm(2,i)
1894 dz_normi=dc_norm(3,i)
1895 xmedi=c(1,i)+0.5d0*dxi
1896 ymedi=c(2,i)+0.5d0*dyi
1897 zmedi=c(3,i)+0.5d0*dzi
1899 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1900 do j=ielstart(i),ielend(i)
1901 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1902 if (itel(j).eq.0) goto 1216
1906 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1907 aaa=app(iteli,itelj)
1908 bbb=bpp(iteli,itelj)
1909 C Diagnostics only!!!
1915 ael6i=ael6(iteli,itelj)
1916 ael3i=ael3(iteli,itelj)
1920 dx_normj=dc_norm(1,j)
1921 dy_normj=dc_norm(2,j)
1922 dz_normj=dc_norm(3,j)
1923 xj=c(1,j)+0.5D0*dxj-xmedi
1924 yj=c(2,j)+0.5D0*dyj-ymedi
1925 zj=c(3,j)+0.5D0*dzj-zmedi
1926 rij=xj*xj+yj*yj+zj*zj
1932 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1933 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1934 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1935 fac=cosa-3.0D0*cosb*cosg
1937 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1938 if (j.eq.i+2) ev1=scal_el*ev1
1943 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1946 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1947 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1948 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1951 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
1952 c &'evdw1',i,j,evdwij
1953 c &,iteli,itelj,aaa,evdw1
1955 c write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
1956 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1957 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1958 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1959 c & xmedi,ymedi,zmedi,xj,yj,zj
1961 C Calculate contributions to the Cartesian gradient.
1964 facvdw=-6*rrmij*(ev1+evdwij)
1965 facel=-3*rrmij*(el1+eesij)
1972 * Radial derivatives. First process both termini of the fragment (i,j)
1979 gelc(k,i)=gelc(k,i)+ghalf
1980 gelc(k,j)=gelc(k,j)+ghalf
1983 * Loop over residues i+1 thru j-1.
1987 gelc(l,k)=gelc(l,k)+ggg(l)
1995 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1996 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1999 * Loop over residues i+1 thru j-1.
2003 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2010 fac=-3*rrmij*(facvdw+facvdw+facel)
2016 * Radial derivatives. First process both termini of the fragment (i,j)
2023 gelc(k,i)=gelc(k,i)+ghalf
2024 gelc(k,j)=gelc(k,j)+ghalf
2027 * Loop over residues i+1 thru j-1.
2031 gelc(l,k)=gelc(l,k)+ggg(l)
2038 ecosa=2.0D0*fac3*fac1+fac4
2041 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2042 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2044 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2045 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2047 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2048 cd & (dcosg(k),k=1,3)
2050 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2054 gelc(k,i)=gelc(k,i)+ghalf
2055 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2056 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2057 gelc(k,j)=gelc(k,j)+ghalf
2058 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2059 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2063 gelc(l,k)=gelc(l,k)+ggg(l)
2068 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2069 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2070 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2072 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2073 C energy of a peptide unit is assumed in the form of a second-order
2074 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2075 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2076 C are computed for EVERY pair of non-contiguous peptide groups.
2078 if (j.lt.nres-1) then
2089 muij(kkk)=mu(k,i)*mu(l,j)
2092 cd write (iout,*) 'EELEC: i',i,' j',j
2093 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2094 cd write(iout,*) 'muij',muij
2095 ury=scalar(uy(1,i),erij)
2096 urz=scalar(uz(1,i),erij)
2097 vry=scalar(uy(1,j),erij)
2098 vrz=scalar(uz(1,j),erij)
2099 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2100 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2101 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2102 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2103 C For diagnostics only
2108 fac=dsqrt(-ael6i)*r3ij
2109 cd write (2,*) 'fac=',fac
2110 C For diagnostics only
2116 cd write (iout,'(4i5,4f10.5)')
2117 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2118 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2119 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2120 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2121 cd write (iout,'(4f10.5)')
2122 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2123 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2124 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2125 cd write (iout,'(2i3,9f10.5/)') i,j,
2126 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2128 C Derivatives of the elements of A in virtual-bond vectors
2129 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2136 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2137 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2138 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2139 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2140 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2141 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2142 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2143 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2144 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2145 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2146 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2147 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2157 C Compute radial contributions to the gradient
2179 C Add the contributions coming from er
2182 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2183 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2184 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2185 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2188 C Derivatives in DC(i)
2189 ghalf1=0.5d0*agg(k,1)
2190 ghalf2=0.5d0*agg(k,2)
2191 ghalf3=0.5d0*agg(k,3)
2192 ghalf4=0.5d0*agg(k,4)
2193 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2194 & -3.0d0*uryg(k,2)*vry)+ghalf1
2195 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2196 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2197 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2198 & -3.0d0*urzg(k,2)*vry)+ghalf3
2199 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2200 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2201 C Derivatives in DC(i+1)
2202 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2203 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2204 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2205 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2206 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2207 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2208 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2209 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2210 C Derivatives in DC(j)
2211 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2212 & -3.0d0*vryg(k,2)*ury)+ghalf1
2213 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2214 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2215 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2216 & -3.0d0*vryg(k,2)*urz)+ghalf3
2217 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2218 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2219 C Derivatives in DC(j+1) or DC(nres-1)
2220 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2221 & -3.0d0*vryg(k,3)*ury)
2222 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2223 & -3.0d0*vrzg(k,3)*ury)
2224 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2225 & -3.0d0*vryg(k,3)*urz)
2226 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2227 & -3.0d0*vrzg(k,3)*urz)
2232 C Derivatives in DC(i+1)
2233 cd aggi1(k,1)=agg(k,1)
2234 cd aggi1(k,2)=agg(k,2)
2235 cd aggi1(k,3)=agg(k,3)
2236 cd aggi1(k,4)=agg(k,4)
2237 C Derivatives in DC(j)
2242 C Derivatives in DC(j+1)
2247 if (j.eq.nres-1 .and. i.lt.j-2) then
2249 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2250 cd aggj1(k,l)=agg(k,l)
2256 C Check the loc-el terms by numerical integration
2266 aggi(k,l)=-aggi(k,l)
2267 aggi1(k,l)=-aggi1(k,l)
2268 aggj(k,l)=-aggj(k,l)
2269 aggj1(k,l)=-aggj1(k,l)
2272 if (j.lt.nres-1) then
2278 aggi(k,l)=-aggi(k,l)
2279 aggi1(k,l)=-aggi1(k,l)
2280 aggj(k,l)=-aggj(k,l)
2281 aggj1(k,l)=-aggj1(k,l)
2292 aggi(k,l)=-aggi(k,l)
2293 aggi1(k,l)=-aggi1(k,l)
2294 aggj(k,l)=-aggj(k,l)
2295 aggj1(k,l)=-aggj1(k,l)
2301 IF (wel_loc.gt.0.0d0) THEN
2302 C Contribution to the local-electrostatic energy coming from the i-j pair
2303 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2305 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2306 c write (iout,'(a6,2i5,0pf7.3)')
2307 c & 'eelloc',i,j,eel_loc_ij
2308 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2309 eel_loc=eel_loc+eel_loc_ij
2310 C Partial derivatives in virtual-bond dihedral angles gamma
2313 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2314 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2315 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2316 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2317 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2318 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2319 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2320 cd write(iout,*) 'agg ',agg
2321 cd write(iout,*) 'aggi ',aggi
2322 cd write(iout,*) 'aggi1',aggi1
2323 cd write(iout,*) 'aggj ',aggj
2324 cd write(iout,*) 'aggj1',aggj1
2326 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2328 ggg(l)=agg(l,1)*muij(1)+
2329 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2333 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2336 C Remaining derivatives of eello
2338 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2339 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2340 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2341 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2342 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2343 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2344 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2345 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2349 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2350 C Contributions from turns
2355 call eturn34(i,j,eello_turn3,eello_turn4)
2357 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2358 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2360 C Calculate the contact function. The ith column of the array JCONT will
2361 C contain the numbers of atoms that make contacts with the atom I (of numbers
2362 C greater than I). The arrays FACONT and GACONT will contain the values of
2363 C the contact function and its derivative.
2364 c r0ij=1.02D0*rpp(iteli,itelj)
2365 c r0ij=1.11D0*rpp(iteli,itelj)
2366 r0ij=2.20D0*rpp(iteli,itelj)
2367 c r0ij=1.55D0*rpp(iteli,itelj)
2368 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2369 if (fcont.gt.0.0D0) then
2370 num_conti=num_conti+1
2371 if (num_conti.gt.maxconts) then
2372 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2373 & ' will skip next contacts for this conf.'
2375 jcont_hb(num_conti,i)=j
2376 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2377 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2378 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2380 d_cont(num_conti,i)=rij
2381 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2382 C --- Electrostatic-interaction matrix ---
2383 a_chuj(1,1,num_conti,i)=a22
2384 a_chuj(1,2,num_conti,i)=a23
2385 a_chuj(2,1,num_conti,i)=a32
2386 a_chuj(2,2,num_conti,i)=a33
2387 C --- Gradient of rij
2389 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2392 c a_chuj(1,1,num_conti,i)=-0.61d0
2393 c a_chuj(1,2,num_conti,i)= 0.4d0
2394 c a_chuj(2,1,num_conti,i)= 0.65d0
2395 c a_chuj(2,2,num_conti,i)= 0.50d0
2396 c else if (i.eq.2) then
2397 c a_chuj(1,1,num_conti,i)= 0.0d0
2398 c a_chuj(1,2,num_conti,i)= 0.0d0
2399 c a_chuj(2,1,num_conti,i)= 0.0d0
2400 c a_chuj(2,2,num_conti,i)= 0.0d0
2402 C --- and its gradients
2403 cd write (iout,*) 'i',i,' j',j
2405 cd write (iout,*) 'iii 1 kkk',kkk
2406 cd write (iout,*) agg(kkk,:)
2409 cd write (iout,*) 'iii 2 kkk',kkk
2410 cd write (iout,*) aggi(kkk,:)
2413 cd write (iout,*) 'iii 3 kkk',kkk
2414 cd write (iout,*) aggi1(kkk,:)
2417 cd write (iout,*) 'iii 4 kkk',kkk
2418 cd write (iout,*) aggj(kkk,:)
2421 cd write (iout,*) 'iii 5 kkk',kkk
2422 cd write (iout,*) aggj1(kkk,:)
2429 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2430 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2431 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2432 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2433 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2435 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2441 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2442 C Calculate contact energies
2444 wij=cosa-3.0D0*cosb*cosg
2447 c fac3=dsqrt(-ael6i)/r0ij**3
2448 fac3=dsqrt(-ael6i)*r3ij
2449 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2450 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2452 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2453 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2454 C Diagnostics. Comment out or remove after debugging!
2455 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2456 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2457 c ees0m(num_conti,i)=0.0D0
2459 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2460 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2461 facont_hb(num_conti,i)=fcont
2463 C Angular derivatives of the contact function
2464 ees0pij1=fac3/ees0pij
2465 ees0mij1=fac3/ees0mij
2466 fac3p=-3.0D0*fac3*rrmij
2467 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2468 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2470 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2471 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2472 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2473 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2474 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2475 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2476 ecosap=ecosa1+ecosa2
2477 ecosbp=ecosb1+ecosb2
2478 ecosgp=ecosg1+ecosg2
2479 ecosam=ecosa1-ecosa2
2480 ecosbm=ecosb1-ecosb2
2481 ecosgm=ecosg1-ecosg2
2490 fprimcont=fprimcont/rij
2491 cd facont_hb(num_conti,i)=1.0D0
2492 C Following line is for diagnostics.
2495 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2496 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2499 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2500 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2502 gggp(1)=gggp(1)+ees0pijp*xj
2503 gggp(2)=gggp(2)+ees0pijp*yj
2504 gggp(3)=gggp(3)+ees0pijp*zj
2505 gggm(1)=gggm(1)+ees0mijp*xj
2506 gggm(2)=gggm(2)+ees0mijp*yj
2507 gggm(3)=gggm(3)+ees0mijp*zj
2508 C Derivatives due to the contact function
2509 gacont_hbr(1,num_conti,i)=fprimcont*xj
2510 gacont_hbr(2,num_conti,i)=fprimcont*yj
2511 gacont_hbr(3,num_conti,i)=fprimcont*zj
2513 ghalfp=0.5D0*gggp(k)
2514 ghalfm=0.5D0*gggm(k)
2515 gacontp_hb1(k,num_conti,i)=ghalfp
2516 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2517 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2518 gacontp_hb2(k,num_conti,i)=ghalfp
2519 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2520 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2521 gacontp_hb3(k,num_conti,i)=gggp(k)
2522 gacontm_hb1(k,num_conti,i)=ghalfm
2523 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2524 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2525 gacontm_hb2(k,num_conti,i)=ghalfm
2526 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2527 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2528 gacontm_hb3(k,num_conti,i)=gggm(k)
2531 C Diagnostics. Comment out or remove after debugging!
2533 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2534 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2535 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2536 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2537 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2538 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2541 endif ! num_conti.le.maxconts
2546 num_cont_hb(i)=num_conti
2550 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2551 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2553 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2554 ccc eel_loc=eel_loc+eello_turn3
2557 C-----------------------------------------------------------------------------
2558 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2559 C Third- and fourth-order contributions from turns
2560 implicit real*8 (a-h,o-z)
2561 include 'DIMENSIONS'
2562 include 'DIMENSIONS.ZSCOPT'
2563 include 'COMMON.IOUNITS'
2564 include 'COMMON.GEO'
2565 include 'COMMON.VAR'
2566 include 'COMMON.LOCAL'
2567 include 'COMMON.CHAIN'
2568 include 'COMMON.DERIV'
2569 include 'COMMON.INTERACT'
2570 include 'COMMON.CONTACTS'
2571 include 'COMMON.TORSION'
2572 include 'COMMON.VECTORS'
2573 include 'COMMON.FFIELD'
2575 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2576 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2577 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2578 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2579 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2580 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2582 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2584 C Third-order contributions
2591 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2592 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2593 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2594 call transpose2(auxmat(1,1),auxmat1(1,1))
2595 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2596 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2597 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2598 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2599 cd & ' eello_turn3_num',4*eello_turn3_num
2601 C Derivatives in gamma(i)
2602 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2603 call transpose2(auxmat2(1,1),pizda(1,1))
2604 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2605 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2606 C Derivatives in gamma(i+1)
2607 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2608 call transpose2(auxmat2(1,1),pizda(1,1))
2609 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2610 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2611 & +0.5d0*(pizda(1,1)+pizda(2,2))
2612 C Cartesian derivatives
2614 a_temp(1,1)=aggi(l,1)
2615 a_temp(1,2)=aggi(l,2)
2616 a_temp(2,1)=aggi(l,3)
2617 a_temp(2,2)=aggi(l,4)
2618 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2619 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2620 & +0.5d0*(pizda(1,1)+pizda(2,2))
2621 a_temp(1,1)=aggi1(l,1)
2622 a_temp(1,2)=aggi1(l,2)
2623 a_temp(2,1)=aggi1(l,3)
2624 a_temp(2,2)=aggi1(l,4)
2625 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2626 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2627 & +0.5d0*(pizda(1,1)+pizda(2,2))
2628 a_temp(1,1)=aggj(l,1)
2629 a_temp(1,2)=aggj(l,2)
2630 a_temp(2,1)=aggj(l,3)
2631 a_temp(2,2)=aggj(l,4)
2632 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2633 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2634 & +0.5d0*(pizda(1,1)+pizda(2,2))
2635 a_temp(1,1)=aggj1(l,1)
2636 a_temp(1,2)=aggj1(l,2)
2637 a_temp(2,1)=aggj1(l,3)
2638 a_temp(2,2)=aggj1(l,4)
2639 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2640 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2641 & +0.5d0*(pizda(1,1)+pizda(2,2))
2644 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2645 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2647 C Fourth-order contributions
2655 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2656 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2657 iti1=itortyp(itype(i+1))
2658 iti2=itortyp(itype(i+2))
2659 iti3=itortyp(itype(i+3))
2660 call transpose2(EUg(1,1,i+1),e1t(1,1))
2661 call transpose2(Eug(1,1,i+2),e2t(1,1))
2662 call transpose2(Eug(1,1,i+3),e3t(1,1))
2663 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2664 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2665 s1=scalar2(b1(1,iti2),auxvec(1))
2666 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2667 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2668 s2=scalar2(b1(1,iti1),auxvec(1))
2669 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2670 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2671 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2672 eello_turn4=eello_turn4-(s1+s2+s3)
2673 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2674 cd & ' eello_turn4_num',8*eello_turn4_num
2675 C Derivatives in gamma(i)
2677 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2678 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2679 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2680 s1=scalar2(b1(1,iti2),auxvec(1))
2681 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2682 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2683 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2684 C Derivatives in gamma(i+1)
2685 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2686 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2687 s2=scalar2(b1(1,iti1),auxvec(1))
2688 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2689 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2690 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2691 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2692 C Derivatives in gamma(i+2)
2693 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2694 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2695 s1=scalar2(b1(1,iti2),auxvec(1))
2696 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2697 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2698 s2=scalar2(b1(1,iti1),auxvec(1))
2699 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2700 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2701 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2702 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2703 C Cartesian derivatives
2704 C Derivatives of this turn contributions in DC(i+2)
2705 if (j.lt.nres-1) then
2707 a_temp(1,1)=agg(l,1)
2708 a_temp(1,2)=agg(l,2)
2709 a_temp(2,1)=agg(l,3)
2710 a_temp(2,2)=agg(l,4)
2711 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2712 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2713 s1=scalar2(b1(1,iti2),auxvec(1))
2714 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2715 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2716 s2=scalar2(b1(1,iti1),auxvec(1))
2717 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2718 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2719 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2721 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2724 C Remaining derivatives of this turn contribution
2726 a_temp(1,1)=aggi(l,1)
2727 a_temp(1,2)=aggi(l,2)
2728 a_temp(2,1)=aggi(l,3)
2729 a_temp(2,2)=aggi(l,4)
2730 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2731 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2732 s1=scalar2(b1(1,iti2),auxvec(1))
2733 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2734 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2735 s2=scalar2(b1(1,iti1),auxvec(1))
2736 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2737 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2738 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2739 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2740 a_temp(1,1)=aggi1(l,1)
2741 a_temp(1,2)=aggi1(l,2)
2742 a_temp(2,1)=aggi1(l,3)
2743 a_temp(2,2)=aggi1(l,4)
2744 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2745 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2746 s1=scalar2(b1(1,iti2),auxvec(1))
2747 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2748 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2749 s2=scalar2(b1(1,iti1),auxvec(1))
2750 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2751 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2752 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2753 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2754 a_temp(1,1)=aggj(l,1)
2755 a_temp(1,2)=aggj(l,2)
2756 a_temp(2,1)=aggj(l,3)
2757 a_temp(2,2)=aggj(l,4)
2758 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2759 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2760 s1=scalar2(b1(1,iti2),auxvec(1))
2761 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2762 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2763 s2=scalar2(b1(1,iti1),auxvec(1))
2764 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2765 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2766 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2767 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2768 a_temp(1,1)=aggj1(l,1)
2769 a_temp(1,2)=aggj1(l,2)
2770 a_temp(2,1)=aggj1(l,3)
2771 a_temp(2,2)=aggj1(l,4)
2772 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2773 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2774 s1=scalar2(b1(1,iti2),auxvec(1))
2775 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2776 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2777 s2=scalar2(b1(1,iti1),auxvec(1))
2778 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2779 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2780 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2781 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2787 C-----------------------------------------------------------------------------
2788 subroutine vecpr(u,v,w)
2789 implicit real*8(a-h,o-z)
2790 dimension u(3),v(3),w(3)
2791 w(1)=u(2)*v(3)-u(3)*v(2)
2792 w(2)=-u(1)*v(3)+u(3)*v(1)
2793 w(3)=u(1)*v(2)-u(2)*v(1)
2796 C-----------------------------------------------------------------------------
2797 subroutine unormderiv(u,ugrad,unorm,ungrad)
2798 C This subroutine computes the derivatives of a normalized vector u, given
2799 C the derivatives computed without normalization conditions, ugrad. Returns
2802 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2803 double precision vec(3)
2804 double precision scalar
2806 c write (2,*) 'ugrad',ugrad
2809 vec(i)=scalar(ugrad(1,i),u(1))
2811 c write (2,*) 'vec',vec
2814 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2817 c write (2,*) 'ungrad',ungrad
2820 C-----------------------------------------------------------------------------
2821 subroutine escp(evdw2,evdw2_14)
2823 C This subroutine calculates the excluded-volume interaction energy between
2824 C peptide-group centers and side chains and its gradient in virtual-bond and
2825 C side-chain vectors.
2827 implicit real*8 (a-h,o-z)
2828 include 'DIMENSIONS'
2829 include 'DIMENSIONS.ZSCOPT'
2830 include 'COMMON.GEO'
2831 include 'COMMON.VAR'
2832 include 'COMMON.LOCAL'
2833 include 'COMMON.CHAIN'
2834 include 'COMMON.DERIV'
2835 include 'COMMON.INTERACT'
2836 include 'COMMON.FFIELD'
2837 include 'COMMON.IOUNITS'
2841 cd print '(a)','Enter ESCP'
2842 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2843 c & ' scal14',scal14
2844 do i=iatscp_s,iatscp_e
2845 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2847 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2848 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2849 if (iteli.eq.0) goto 1225
2850 xi=0.5D0*(c(1,i)+c(1,i+1))
2851 yi=0.5D0*(c(2,i)+c(2,i+1))
2852 zi=0.5D0*(c(3,i)+c(3,i+1))
2854 do iint=1,nscp_gr(i)
2856 do j=iscpstart(i,iint),iscpend(i,iint)
2857 itypj=iabs(itype(j))
2858 if (itypj.eq.ntyp1) cycle
2859 C Uncomment following three lines for SC-p interactions
2863 C Uncomment following three lines for Ca-p interactions
2867 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2869 e1=fac*fac*aad(itypj,iteli)
2870 e2=fac*bad(itypj,iteli)
2871 if (iabs(j-i) .le. 2) then
2874 evdw2_14=evdw2_14+e1+e2
2877 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
2878 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
2879 c & bad(itypj,iteli)
2883 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2885 fac=-(evdwij+e1)*rrij
2890 cd write (iout,*) 'j<i'
2891 C Uncomment following three lines for SC-p interactions
2893 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2896 cd write (iout,*) 'j>i'
2899 C Uncomment following line for SC-p interactions
2900 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2904 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2908 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2909 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2912 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2922 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2923 gradx_scp(j,i)=expon*gradx_scp(j,i)
2926 C******************************************************************************
2930 C To save time the factor EXPON has been extracted from ALL components
2931 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2934 C******************************************************************************
2937 C--------------------------------------------------------------------------
2938 subroutine edis(ehpb)
2940 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2942 implicit real*8 (a-h,o-z)
2943 include 'DIMENSIONS'
2944 include 'DIMENSIONS.ZSCOPT'
2945 include 'COMMON.SBRIDGE'
2946 include 'COMMON.CHAIN'
2947 include 'COMMON.DERIV'
2948 include 'COMMON.VAR'
2949 include 'COMMON.INTERACT'
2952 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2953 cd print *,'link_start=',link_start,' link_end=',link_end
2954 if (link_end.eq.0) return
2955 do i=link_start,link_end
2956 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2957 C CA-CA distance used in regularization of structure.
2960 C iii and jjj point to the residues for which the distance is assigned.
2961 if (ii.gt.nres) then
2968 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2969 C distance and angle dependent SS bond potential.
2970 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2971 C & iabs(itype(jjj)).eq.1) then
2973 if (.not.dyn_ss .and. i.le.nss) then
2974 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
2975 & iabs(itype(jjj)).eq.1) then
2976 call ssbond_ene(iii,jjj,eij)
2980 C Calculate the distance between the two points and its difference from the
2984 C Get the force constant corresponding to this distance.
2986 C Calculate the contribution to energy.
2987 ehpb=ehpb+waga*rdis*rdis
2989 C Evaluate gradient.
2992 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2993 cd & ' waga=',waga,' fac=',fac
2995 ggg(j)=fac*(c(j,jj)-c(j,ii))
2997 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2998 C If this is a SC-SC distance, we need to calculate the contributions to the
2999 C Cartesian gradient in the SC vectors (ghpbx).
3002 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3003 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3008 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3016 C--------------------------------------------------------------------------
3017 subroutine ssbond_ene(i,j,eij)
3019 C Calculate the distance and angle dependent SS-bond potential energy
3020 C using a free-energy function derived based on RHF/6-31G** ab initio
3021 C calculations of diethyl disulfide.
3023 C A. Liwo and U. Kozlowska, 11/24/03
3025 implicit real*8 (a-h,o-z)
3026 include 'DIMENSIONS'
3027 include 'DIMENSIONS.ZSCOPT'
3028 include 'COMMON.SBRIDGE'
3029 include 'COMMON.CHAIN'
3030 include 'COMMON.DERIV'
3031 include 'COMMON.LOCAL'
3032 include 'COMMON.INTERACT'
3033 include 'COMMON.VAR'
3034 include 'COMMON.IOUNITS'
3035 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3036 itypi=iabs(itype(i))
3040 dxi=dc_norm(1,nres+i)
3041 dyi=dc_norm(2,nres+i)
3042 dzi=dc_norm(3,nres+i)
3043 dsci_inv=dsc_inv(itypi)
3044 itypj=iabs(itype(j))
3045 dscj_inv=dsc_inv(itypj)
3049 dxj=dc_norm(1,nres+j)
3050 dyj=dc_norm(2,nres+j)
3051 dzj=dc_norm(3,nres+j)
3052 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3057 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3058 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3059 om12=dxi*dxj+dyi*dyj+dzi*dzj
3061 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3062 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3068 deltat12=om2-om1+2.0d0
3070 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3071 & +akct*deltad*deltat12
3072 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3073 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3074 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3075 c & " deltat12",deltat12," eij",eij
3076 ed=2*akcm*deltad+akct*deltat12
3078 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3079 eom1=-2*akth*deltat1-pom1-om2*pom2
3080 eom2= 2*akth*deltat2+pom1-om1*pom2
3083 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3086 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3087 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3088 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3089 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3092 C Calculate the components of the gradient in DC and X
3096 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3101 C--------------------------------------------------------------------------
3102 subroutine ebond(estr)
3104 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3106 implicit real*8 (a-h,o-z)
3107 include 'DIMENSIONS'
3108 include 'DIMENSIONS.ZSCOPT'
3109 include 'COMMON.LOCAL'
3110 include 'COMMON.GEO'
3111 include 'COMMON.INTERACT'
3112 include 'COMMON.DERIV'
3113 include 'COMMON.VAR'
3114 include 'COMMON.CHAIN'
3115 include 'COMMON.IOUNITS'
3116 include 'COMMON.NAMES'
3117 include 'COMMON.FFIELD'
3118 include 'COMMON.CONTROL'
3119 logical energy_dec /.false./
3120 double precision u(3),ud(3)
3123 c write (iout,*) "distchainmax",distchainmax
3125 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3126 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3128 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3129 & *dc(j,i-1)/vbld(i)
3131 if (energy_dec) write(iout,*)
3132 & "estr1",i,vbld(i),distchainmax,
3133 & gnmr1(vbld(i),-1.0d0,distchainmax)
3135 diff = vbld(i)-vbldp0
3136 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3139 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3144 estr=0.5d0*AKP*estr+estr1
3146 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3150 if (iti.ne.10 .and. iti.ne.ntyp1) then
3153 diff=vbld(i+nres)-vbldsc0(1,iti)
3154 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3155 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3156 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3158 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3162 diff=vbld(i+nres)-vbldsc0(j,iti)
3163 ud(j)=aksc(j,iti)*diff
3164 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3178 uprod2=uprod2*u(k)*u(k)
3182 usumsqder=usumsqder+ud(j)*uprod2
3184 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3185 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3186 estr=estr+uprod/usum
3188 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3196 C--------------------------------------------------------------------------
3197 subroutine ebend(etheta)
3199 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3200 C angles gamma and its derivatives in consecutive thetas and gammas.
3202 implicit real*8 (a-h,o-z)
3203 include 'DIMENSIONS'
3204 include 'DIMENSIONS.ZSCOPT'
3205 include 'COMMON.LOCAL'
3206 include 'COMMON.GEO'
3207 include 'COMMON.INTERACT'
3208 include 'COMMON.DERIV'
3209 include 'COMMON.VAR'
3210 include 'COMMON.CHAIN'
3211 include 'COMMON.IOUNITS'
3212 include 'COMMON.NAMES'
3213 include 'COMMON.FFIELD'
3214 common /calcthet/ term1,term2,termm,diffak,ratak,
3215 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3216 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3217 double precision y(2),z(2)
3219 c time11=dexp(-2*time)
3222 c write (iout,*) "nres",nres
3223 c write (*,'(a,i2)') 'EBEND ICG=',icg
3224 c write (iout,*) ithet_start,ithet_end
3225 do i=ithet_start,ithet_end
3226 if (itype(i-1).eq.ntyp1) cycle
3227 C Zero the energy function and its derivative at 0 or pi.
3228 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3230 ichir1=isign(1,itype(i-2))
3231 ichir2=isign(1,itype(i))
3232 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3233 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3234 if (itype(i-1).eq.10) then
3235 itype1=isign(10,itype(i-2))
3236 ichir11=isign(1,itype(i-2))
3237 ichir12=isign(1,itype(i-2))
3238 itype2=isign(10,itype(i))
3239 ichir21=isign(1,itype(i))
3240 ichir22=isign(1,itype(i))
3243 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
3247 c call proc_proc(phii,icrc)
3248 if (icrc.eq.1) phii=150.0
3258 if (i.lt.nres .and. itype(i).ne.ntyp1) then
3262 c call proc_proc(phii1,icrc)
3263 if (icrc.eq.1) phii1=150.0
3275 C Calculate the "mean" value of theta from the part of the distribution
3276 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3277 C In following comments this theta will be referred to as t_c.
3278 thet_pred_mean=0.0d0
3280 athetk=athet(k,it,ichir1,ichir2)
3281 bthetk=bthet(k,it,ichir1,ichir2)
3283 athetk=athet(k,itype1,ichir11,ichir12)
3284 bthetk=bthet(k,itype2,ichir21,ichir22)
3286 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3288 c write (iout,*) "thet_pred_mean",thet_pred_mean
3289 dthett=thet_pred_mean*ssd
3290 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3291 c write (iout,*) "thet_pred_mean",thet_pred_mean
3292 C Derivatives of the "mean" values in gamma1 and gamma2.
3293 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3294 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3295 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3296 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3298 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3299 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3300 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3301 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3303 if (theta(i).gt.pi-delta) then
3304 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3306 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3307 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3308 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3310 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3312 else if (theta(i).lt.delta) then
3313 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3314 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3315 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3317 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3318 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3321 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3324 etheta=etheta+ethetai
3325 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3326 c & rad2deg*phii,rad2deg*phii1,ethetai
3327 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3328 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3329 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3332 C Ufff.... We've done all this!!!
3335 C---------------------------------------------------------------------------
3336 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3338 implicit real*8 (a-h,o-z)
3339 include 'DIMENSIONS'
3340 include 'COMMON.LOCAL'
3341 include 'COMMON.IOUNITS'
3342 common /calcthet/ term1,term2,termm,diffak,ratak,
3343 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3344 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3345 C Calculate the contributions to both Gaussian lobes.
3346 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3347 C The "polynomial part" of the "standard deviation" of this part of
3351 sig=sig*thet_pred_mean+polthet(j,it)
3353 C Derivative of the "interior part" of the "standard deviation of the"
3354 C gamma-dependent Gaussian lobe in t_c.
3355 sigtc=3*polthet(3,it)
3357 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3360 C Set the parameters of both Gaussian lobes of the distribution.
3361 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3362 fac=sig*sig+sigc0(it)
3365 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3366 sigsqtc=-4.0D0*sigcsq*sigtc
3367 c print *,i,sig,sigtc,sigsqtc
3368 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3369 sigtc=-sigtc/(fac*fac)
3370 C Following variable is sigma(t_c)**(-2)
3371 sigcsq=sigcsq*sigcsq
3373 sig0inv=1.0D0/sig0i**2
3374 delthec=thetai-thet_pred_mean
3375 delthe0=thetai-theta0i
3376 term1=-0.5D0*sigcsq*delthec*delthec
3377 term2=-0.5D0*sig0inv*delthe0*delthe0
3378 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3379 C NaNs in taking the logarithm. We extract the largest exponent which is added
3380 C to the energy (this being the log of the distribution) at the end of energy
3381 C term evaluation for this virtual-bond angle.
3382 if (term1.gt.term2) then
3384 term2=dexp(term2-termm)
3388 term1=dexp(term1-termm)
3391 C The ratio between the gamma-independent and gamma-dependent lobes of
3392 C the distribution is a Gaussian function of thet_pred_mean too.
3393 diffak=gthet(2,it)-thet_pred_mean
3394 ratak=diffak/gthet(3,it)**2
3395 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3396 C Let's differentiate it in thet_pred_mean NOW.
3398 C Now put together the distribution terms to make complete distribution.
3399 termexp=term1+ak*term2
3400 termpre=sigc+ak*sig0i
3401 C Contribution of the bending energy from this theta is just the -log of
3402 C the sum of the contributions from the two lobes and the pre-exponential
3403 C factor. Simple enough, isn't it?
3404 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3405 C NOW the derivatives!!!
3406 C 6/6/97 Take into account the deformation.
3407 E_theta=(delthec*sigcsq*term1
3408 & +ak*delthe0*sig0inv*term2)/termexp
3409 E_tc=((sigtc+aktc*sig0i)/termpre
3410 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3411 & aktc*term2)/termexp)
3414 c-----------------------------------------------------------------------------
3415 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3416 implicit real*8 (a-h,o-z)
3417 include 'DIMENSIONS'
3418 include 'COMMON.LOCAL'
3419 include 'COMMON.IOUNITS'
3420 common /calcthet/ term1,term2,termm,diffak,ratak,
3421 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3422 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3423 delthec=thetai-thet_pred_mean
3424 delthe0=thetai-theta0i
3425 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3426 t3 = thetai-thet_pred_mean
3430 t14 = t12+t6*sigsqtc
3432 t21 = thetai-theta0i
3438 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3439 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3440 & *(-t12*t9-ak*sig0inv*t27)
3444 C--------------------------------------------------------------------------
3445 subroutine ebend(etheta)
3447 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3448 C angles gamma and its derivatives in consecutive thetas and gammas.
3449 C ab initio-derived potentials from
3450 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3452 implicit real*8 (a-h,o-z)
3453 include 'DIMENSIONS'
3454 include 'DIMENSIONS.ZSCOPT'
3455 include 'COMMON.LOCAL'
3456 include 'COMMON.GEO'
3457 include 'COMMON.INTERACT'
3458 include 'COMMON.DERIV'
3459 include 'COMMON.VAR'
3460 include 'COMMON.CHAIN'
3461 include 'COMMON.IOUNITS'
3462 include 'COMMON.NAMES'
3463 include 'COMMON.FFIELD'
3464 include 'COMMON.CONTROL'
3465 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3466 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3467 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3468 & sinph1ph2(maxdouble,maxdouble)
3469 logical lprn /.false./, lprn1 /.false./
3471 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3472 do i=ithet_start,ithet_end
3473 c if (itype(i-1).eq.ntyp1) cycle
3474 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3475 &(itype(i).eq.ntyp1)) cycle
3476 if (iabs(itype(i+1)).eq.20) iblock=2
3477 if (iabs(itype(i+1)).ne.20) iblock=1
3481 theti2=0.5d0*theta(i)
3482 ityp2=ithetyp((itype(i-1)))
3484 coskt(k)=dcos(k*theti2)
3485 sinkt(k)=dsin(k*theti2)
3487 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3490 if (phii.ne.phii) phii=150.0
3494 ityp1=ithetyp((itype(i-2)))
3496 cosph1(k)=dcos(k*phii)
3497 sinph1(k)=dsin(k*phii)
3503 ityp1=ithetyp((itype(i-2)))
3508 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3511 if (phii1.ne.phii1) phii1=150.0
3516 ityp3=ithetyp((itype(i)))
3518 cosph2(k)=dcos(k*phii1)
3519 sinph2(k)=dsin(k*phii1)
3524 ityp3=ithetyp((itype(i)))
3530 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3531 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3533 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3536 ccl=cosph1(l)*cosph2(k-l)
3537 ssl=sinph1(l)*sinph2(k-l)
3538 scl=sinph1(l)*cosph2(k-l)
3539 csl=cosph1(l)*sinph2(k-l)
3540 cosph1ph2(l,k)=ccl-ssl
3541 cosph1ph2(k,l)=ccl+ssl
3542 sinph1ph2(l,k)=scl+csl
3543 sinph1ph2(k,l)=scl-csl
3547 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3548 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3549 write (iout,*) "coskt and sinkt"
3551 write (iout,*) k,coskt(k),sinkt(k)
3555 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3556 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3559 & write (iout,*) "k",k,"
3560 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3561 & " ethetai",ethetai
3564 write (iout,*) "cosph and sinph"
3566 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3568 write (iout,*) "cosph1ph2 and sinph2ph2"
3571 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3572 & sinph1ph2(l,k),sinph1ph2(k,l)
3575 write(iout,*) "ethetai",ethetai
3579 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3580 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3581 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3582 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3583 ethetai=ethetai+sinkt(m)*aux
3584 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3585 dephii=dephii+k*sinkt(m)*(
3586 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3587 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3588 dephii1=dephii1+k*sinkt(m)*(
3589 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3590 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3592 & write (iout,*) "m",m," k",k," bbthet",
3593 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3594 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3595 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3596 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3600 & write(iout,*) "ethetai",ethetai
3604 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3605 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3606 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3607 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3608 ethetai=ethetai+sinkt(m)*aux
3609 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3610 dephii=dephii+l*sinkt(m)*(
3611 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3612 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3613 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3614 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3615 dephii1=dephii1+(k-l)*sinkt(m)*(
3616 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3617 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3618 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3619 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3621 write (iout,*) "m",m," k",k," l",l," ffthet",
3622 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3623 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3624 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3625 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3626 & " ethetai",ethetai
3627 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3628 & cosph1ph2(k,l)*sinkt(m),
3629 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3635 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3636 & i,theta(i)*rad2deg,phii*rad2deg,
3637 & phii1*rad2deg,ethetai
3638 etheta=etheta+ethetai
3639 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3640 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3641 c gloc(nphi+i-2,icg)=wang*dethetai
3642 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
3648 c-----------------------------------------------------------------------------
3649 subroutine esc(escloc)
3650 C Calculate the local energy of a side chain and its derivatives in the
3651 C corresponding virtual-bond valence angles THETA and the spherical angles
3653 implicit real*8 (a-h,o-z)
3654 include 'DIMENSIONS'
3655 include 'DIMENSIONS.ZSCOPT'
3656 include 'COMMON.GEO'
3657 include 'COMMON.LOCAL'
3658 include 'COMMON.VAR'
3659 include 'COMMON.INTERACT'
3660 include 'COMMON.DERIV'
3661 include 'COMMON.CHAIN'
3662 include 'COMMON.IOUNITS'
3663 include 'COMMON.NAMES'
3664 include 'COMMON.FFIELD'
3665 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3666 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3667 common /sccalc/ time11,time12,time112,theti,it,nlobit
3670 c write (iout,'(a)') 'ESC'
3671 do i=loc_start,loc_end
3673 if (it.eq.ntyp1) cycle
3674 if (it.eq.10) goto 1
3675 nlobit=nlob(iabs(it))
3676 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3677 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3678 theti=theta(i+1)-pipol
3682 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3684 if (x(2).gt.pi-delta) then
3688 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3690 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3691 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3693 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3694 & ddersc0(1),dersc(1))
3695 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3696 & ddersc0(3),dersc(3))
3698 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3700 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3701 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3702 & dersc0(2),esclocbi,dersc02)
3703 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3705 call splinthet(x(2),0.5d0*delta,ss,ssd)
3710 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3712 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3713 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3715 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3717 c write (iout,*) escloci
3718 else if (x(2).lt.delta) then
3722 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3724 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3725 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3727 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3728 & ddersc0(1),dersc(1))
3729 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3730 & ddersc0(3),dersc(3))
3732 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3734 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3735 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3736 & dersc0(2),esclocbi,dersc02)
3737 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3742 call splinthet(x(2),0.5d0*delta,ss,ssd)
3744 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3746 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3747 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3749 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3750 c write (iout,*) escloci
3752 call enesc(x,escloci,dersc,ddummy,.false.)
3755 escloc=escloc+escloci
3756 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3758 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3760 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3761 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3766 C---------------------------------------------------------------------------
3767 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3768 implicit real*8 (a-h,o-z)
3769 include 'DIMENSIONS'
3770 include 'COMMON.GEO'
3771 include 'COMMON.LOCAL'
3772 include 'COMMON.IOUNITS'
3773 common /sccalc/ time11,time12,time112,theti,it,nlobit
3774 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3775 double precision contr(maxlob,-1:1)
3777 c write (iout,*) 'it=',it,' nlobit=',nlobit
3781 if (mixed) ddersc(j)=0.0d0
3785 C Because of periodicity of the dependence of the SC energy in omega we have
3786 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3787 C To avoid underflows, first compute & store the exponents.
3795 z(k)=x(k)-censc(k,j,it)
3800 Axk=Axk+gaussc(l,k,j,it)*z(l)
3806 expfac=expfac+Ax(k,j,iii)*z(k)
3814 C As in the case of ebend, we want to avoid underflows in exponentiation and
3815 C subsequent NaNs and INFs in energy calculation.
3816 C Find the largest exponent
3820 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3824 cd print *,'it=',it,' emin=',emin
3826 C Compute the contribution to SC energy and derivatives
3830 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3831 cd print *,'j=',j,' expfac=',expfac
3832 escloc_i=escloc_i+expfac
3834 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3838 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3839 & +gaussc(k,2,j,it))*expfac
3846 dersc(1)=dersc(1)/cos(theti)**2
3847 ddersc(1)=ddersc(1)/cos(theti)**2
3850 escloci=-(dlog(escloc_i)-emin)
3852 dersc(j)=dersc(j)/escloc_i
3856 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3861 C------------------------------------------------------------------------------
3862 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3863 implicit real*8 (a-h,o-z)
3864 include 'DIMENSIONS'
3865 include 'COMMON.GEO'
3866 include 'COMMON.LOCAL'
3867 include 'COMMON.IOUNITS'
3868 common /sccalc/ time11,time12,time112,theti,it,nlobit
3869 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3870 double precision contr(maxlob)
3881 z(k)=x(k)-censc(k,j,it)
3887 Axk=Axk+gaussc(l,k,j,it)*z(l)
3893 expfac=expfac+Ax(k,j)*z(k)
3898 C As in the case of ebend, we want to avoid underflows in exponentiation and
3899 C subsequent NaNs and INFs in energy calculation.
3900 C Find the largest exponent
3903 if (emin.gt.contr(j)) emin=contr(j)
3907 C Compute the contribution to SC energy and derivatives
3911 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
3912 escloc_i=escloc_i+expfac
3914 dersc(k)=dersc(k)+Ax(k,j)*expfac
3916 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3917 & +gaussc(1,2,j,it))*expfac
3921 dersc(1)=dersc(1)/cos(theti)**2
3922 dersc12=dersc12/cos(theti)**2
3923 escloci=-(dlog(escloc_i)-emin)
3925 dersc(j)=dersc(j)/escloc_i
3927 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3931 c----------------------------------------------------------------------------------
3932 subroutine esc(escloc)
3933 C Calculate the local energy of a side chain and its derivatives in the
3934 C corresponding virtual-bond valence angles THETA and the spherical angles
3935 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3936 C added by Urszula Kozlowska. 07/11/2007
3938 implicit real*8 (a-h,o-z)
3939 include 'DIMENSIONS'
3940 include 'DIMENSIONS.ZSCOPT'
3941 include 'COMMON.GEO'
3942 include 'COMMON.LOCAL'
3943 include 'COMMON.VAR'
3944 include 'COMMON.SCROT'
3945 include 'COMMON.INTERACT'
3946 include 'COMMON.DERIV'
3947 include 'COMMON.CHAIN'
3948 include 'COMMON.IOUNITS'
3949 include 'COMMON.NAMES'
3950 include 'COMMON.FFIELD'
3951 include 'COMMON.CONTROL'
3952 include 'COMMON.VECTORS'
3953 double precision x_prime(3),y_prime(3),z_prime(3)
3954 & , sumene,dsc_i,dp2_i,x(65),
3955 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3956 & de_dxx,de_dyy,de_dzz,de_dt
3957 double precision s1_t,s1_6_t,s2_t,s2_6_t
3959 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3960 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3961 & dt_dCi(3),dt_dCi1(3)
3962 common /sccalc/ time11,time12,time112,theti,it,nlobit
3965 do i=loc_start,loc_end
3966 if (itype(i).eq.ntyp1) cycle
3967 costtab(i+1) =dcos(theta(i+1))
3968 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3969 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3970 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3971 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3972 cosfac=dsqrt(cosfac2)
3973 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3974 sinfac=dsqrt(sinfac2)
3976 if (it.eq.10) goto 1
3978 C Compute the axes of tghe local cartesian coordinates system; store in
3979 c x_prime, y_prime and z_prime
3986 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3987 C & dc_norm(3,i+nres)
3989 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3990 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3993 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
3996 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3997 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3998 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3999 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4000 c & " xy",scalar(x_prime(1),y_prime(1)),
4001 c & " xz",scalar(x_prime(1),z_prime(1)),
4002 c & " yy",scalar(y_prime(1),y_prime(1)),
4003 c & " yz",scalar(y_prime(1),z_prime(1)),
4004 c & " zz",scalar(z_prime(1),z_prime(1))
4006 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4007 C to local coordinate system. Store in xx, yy, zz.
4013 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4014 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4015 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4022 C Compute the energy of the ith side cbain
4024 c write (2,*) "xx",xx," yy",yy," zz",zz
4027 x(j) = sc_parmin(j,it)
4030 Cc diagnostics - remove later
4032 yy1 = dsin(alph(2))*dcos(omeg(2))
4033 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4034 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4035 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4037 C," --- ", xx_w,yy_w,zz_w
4040 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4041 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4043 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4044 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4046 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4047 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4048 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4049 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4050 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4052 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4053 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4054 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4055 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4056 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4058 dsc_i = 0.743d0+x(61)
4060 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4061 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4062 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4063 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4064 s1=(1+x(63))/(0.1d0 + dscp1)
4065 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4066 s2=(1+x(65))/(0.1d0 + dscp2)
4067 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4068 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4069 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4070 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4072 c & dscp1,dscp2,sumene
4073 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4074 escloc = escloc + sumene
4075 c write (2,*) "escloc",escloc
4076 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4078 if (.not. calc_grad) goto 1
4081 C This section to check the numerical derivatives of the energy of ith side
4082 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4083 C #define DEBUG in the code to turn it on.
4085 write (2,*) "sumene =",sumene
4089 write (2,*) xx,yy,zz
4090 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4091 de_dxx_num=(sumenep-sumene)/aincr
4093 write (2,*) "xx+ sumene from enesc=",sumenep
4096 write (2,*) xx,yy,zz
4097 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4098 de_dyy_num=(sumenep-sumene)/aincr
4100 write (2,*) "yy+ sumene from enesc=",sumenep
4103 write (2,*) xx,yy,zz
4104 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4105 de_dzz_num=(sumenep-sumene)/aincr
4107 write (2,*) "zz+ sumene from enesc=",sumenep
4108 costsave=cost2tab(i+1)
4109 sintsave=sint2tab(i+1)
4110 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4111 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4112 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4113 de_dt_num=(sumenep-sumene)/aincr
4114 write (2,*) " t+ sumene from enesc=",sumenep
4115 cost2tab(i+1)=costsave
4116 sint2tab(i+1)=sintsave
4117 C End of diagnostics section.
4120 C Compute the gradient of esc
4122 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4123 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4124 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4125 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4126 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4127 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4128 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4129 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4130 pom1=(sumene3*sint2tab(i+1)+sumene1)
4131 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4132 pom2=(sumene4*cost2tab(i+1)+sumene2)
4133 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4134 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4135 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4136 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4138 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4139 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4140 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4142 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4143 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4144 & +(pom1+pom2)*pom_dx
4146 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4149 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4150 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4151 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4153 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4154 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4155 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4156 & +x(59)*zz**2 +x(60)*xx*zz
4157 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4158 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4159 & +(pom1-pom2)*pom_dy
4161 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4164 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4165 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4166 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4167 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4168 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4169 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4170 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4171 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4173 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4176 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4177 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4178 & +pom1*pom_dt1+pom2*pom_dt2
4180 write(2,*), "de_dt = ", de_dt,de_dt_num
4184 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4185 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4186 cosfac2xx=cosfac2*xx
4187 sinfac2yy=sinfac2*yy
4189 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4191 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4193 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4194 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4195 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4196 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4197 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4198 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4199 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4200 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4201 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4202 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4206 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4207 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4208 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4209 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4212 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4213 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4214 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4216 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4217 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4221 dXX_Ctab(k,i)=dXX_Ci(k)
4222 dXX_C1tab(k,i)=dXX_Ci1(k)
4223 dYY_Ctab(k,i)=dYY_Ci(k)
4224 dYY_C1tab(k,i)=dYY_Ci1(k)
4225 dZZ_Ctab(k,i)=dZZ_Ci(k)
4226 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4227 dXX_XYZtab(k,i)=dXX_XYZ(k)
4228 dYY_XYZtab(k,i)=dYY_XYZ(k)
4229 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4233 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4234 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4235 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4236 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4237 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4239 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4240 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4241 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4242 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4243 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4244 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4245 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4246 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4248 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4249 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4251 C to check gradient call subroutine check_grad
4258 c------------------------------------------------------------------------------
4259 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4261 C This procedure calculates two-body contact function g(rij) and its derivative:
4264 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4267 C where x=(rij-r0ij)/delta
4269 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4272 double precision rij,r0ij,eps0ij,fcont,fprimcont
4273 double precision x,x2,x4,delta
4277 if (x.lt.-1.0D0) then
4280 else if (x.le.1.0D0) then
4283 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4284 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4291 c------------------------------------------------------------------------------
4292 subroutine splinthet(theti,delta,ss,ssder)
4293 implicit real*8 (a-h,o-z)
4294 include 'DIMENSIONS'
4295 include 'DIMENSIONS.ZSCOPT'
4296 include 'COMMON.VAR'
4297 include 'COMMON.GEO'
4300 if (theti.gt.pipol) then
4301 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4303 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4308 c------------------------------------------------------------------------------
4309 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4311 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4312 double precision ksi,ksi2,ksi3,a1,a2,a3
4313 a1=fprim0*delta/(f1-f0)
4319 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4320 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4323 c------------------------------------------------------------------------------
4324 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4326 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4327 double precision ksi,ksi2,ksi3,a1,a2,a3
4332 a2=3*(f1x-f0x)-2*fprim0x*delta
4333 a3=fprim0x*delta-2*(f1x-f0x)
4334 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4337 C-----------------------------------------------------------------------------
4339 C-----------------------------------------------------------------------------
4340 subroutine etor(etors,edihcnstr,fact)
4341 implicit real*8 (a-h,o-z)
4342 include 'DIMENSIONS'
4343 include 'DIMENSIONS.ZSCOPT'
4344 include 'COMMON.VAR'
4345 include 'COMMON.GEO'
4346 include 'COMMON.LOCAL'
4347 include 'COMMON.TORSION'
4348 include 'COMMON.INTERACT'
4349 include 'COMMON.DERIV'
4350 include 'COMMON.CHAIN'
4351 include 'COMMON.NAMES'
4352 include 'COMMON.IOUNITS'
4353 include 'COMMON.FFIELD'
4354 include 'COMMON.TORCNSTR'
4356 C Set lprn=.true. for debugging
4360 do i=iphi_start,iphi_end
4361 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4362 & .or. itype(i).eq.ntyp1) cycle
4363 itori=itortyp(itype(i-2))
4364 itori1=itortyp(itype(i-1))
4367 C Proline-Proline pair is a special case...
4368 if (itori.eq.3 .and. itori1.eq.3) then
4369 if (phii.gt.-dwapi3) then
4371 fac=1.0D0/(1.0D0-cosphi)
4372 etorsi=v1(1,3,3)*fac
4373 etorsi=etorsi+etorsi
4374 etors=etors+etorsi-v1(1,3,3)
4375 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4378 v1ij=v1(j+1,itori,itori1)
4379 v2ij=v2(j+1,itori,itori1)
4382 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4383 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4387 v1ij=v1(j,itori,itori1)
4388 v2ij=v2(j,itori,itori1)
4391 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4392 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4396 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4397 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4398 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4399 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4400 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4402 ! 6/20/98 - dihedral angle constraints
4405 itori=idih_constr(i)
4408 if (difi.gt.drange(i)) then
4410 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4411 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4412 else if (difi.lt.-drange(i)) then
4414 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4415 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4417 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4418 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4420 ! write (iout,*) 'edihcnstr',edihcnstr
4423 c------------------------------------------------------------------------------
4425 subroutine etor(etors,edihcnstr,fact)
4426 implicit real*8 (a-h,o-z)
4427 include 'DIMENSIONS'
4428 include 'DIMENSIONS.ZSCOPT'
4429 include 'COMMON.VAR'
4430 include 'COMMON.GEO'
4431 include 'COMMON.LOCAL'
4432 include 'COMMON.TORSION'
4433 include 'COMMON.INTERACT'
4434 include 'COMMON.DERIV'
4435 include 'COMMON.CHAIN'
4436 include 'COMMON.NAMES'
4437 include 'COMMON.IOUNITS'
4438 include 'COMMON.FFIELD'
4439 include 'COMMON.TORCNSTR'
4441 C Set lprn=.true. for debugging
4445 do i=iphi_start,iphi_end
4446 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4447 & .or. itype(i).eq.ntyp1) cycle
4448 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4449 if (iabs(itype(i)).eq.20) then
4454 itori=itortyp(itype(i-2))
4455 itori1=itortyp(itype(i-1))
4458 C Regular cosine and sine terms
4459 do j=1,nterm(itori,itori1,iblock)
4460 v1ij=v1(j,itori,itori1,iblock)
4461 v2ij=v2(j,itori,itori1,iblock)
4464 etors=etors+v1ij*cosphi+v2ij*sinphi
4465 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4469 C E = SUM ----------------------------------- - v1
4470 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4472 cosphi=dcos(0.5d0*phii)
4473 sinphi=dsin(0.5d0*phii)
4474 do j=1,nlor(itori,itori1,iblock)
4475 vl1ij=vlor1(j,itori,itori1)
4476 vl2ij=vlor2(j,itori,itori1)
4477 vl3ij=vlor3(j,itori,itori1)
4478 pom=vl2ij*cosphi+vl3ij*sinphi
4479 pom1=1.0d0/(pom*pom+1.0d0)
4480 etors=etors+vl1ij*pom1
4481 c if (energy_dec) etors_ii=etors_ii+
4484 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4486 C Subtract the constant term
4487 etors=etors-v0(itori,itori1,iblock)
4489 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4490 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4491 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4492 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4493 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4496 ! 6/20/98 - dihedral angle constraints
4499 itori=idih_constr(i)
4501 difi=pinorm(phii-phi0(i))
4503 if (difi.gt.drange(i)) then
4505 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4506 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4507 edihi=0.25d0*ftors*difi**4
4508 else if (difi.lt.-drange(i)) then
4510 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4511 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4512 edihi=0.25d0*ftors*difi**4
4516 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4518 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4519 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4521 ! write (iout,*) 'edihcnstr',edihcnstr
4524 c----------------------------------------------------------------------------
4525 subroutine etor_d(etors_d,fact2)
4526 C 6/23/01 Compute double torsional energy
4527 implicit real*8 (a-h,o-z)
4528 include 'DIMENSIONS'
4529 include 'DIMENSIONS.ZSCOPT'
4530 include 'COMMON.VAR'
4531 include 'COMMON.GEO'
4532 include 'COMMON.LOCAL'
4533 include 'COMMON.TORSION'
4534 include 'COMMON.INTERACT'
4535 include 'COMMON.DERIV'
4536 include 'COMMON.CHAIN'
4537 include 'COMMON.NAMES'
4538 include 'COMMON.IOUNITS'
4539 include 'COMMON.FFIELD'
4540 include 'COMMON.TORCNSTR'
4542 C Set lprn=.true. for debugging
4546 do i=iphi_start,iphi_end-1
4547 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4548 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4549 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4551 itori=itortyp(itype(i-2))
4552 itori1=itortyp(itype(i-1))
4553 itori2=itortyp(itype(i))
4559 if (iabs(itype(i+1)).eq.20) iblock=2
4560 C Regular cosine and sine terms
4561 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4562 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4563 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4564 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4565 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4566 cosphi1=dcos(j*phii)
4567 sinphi1=dsin(j*phii)
4568 cosphi2=dcos(j*phii1)
4569 sinphi2=dsin(j*phii1)
4570 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4571 & v2cij*cosphi2+v2sij*sinphi2
4572 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4573 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4575 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4577 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4578 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4579 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4580 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4581 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4582 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4583 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4584 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4585 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4586 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4587 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4588 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4589 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4590 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4593 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4594 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4600 c------------------------------------------------------------------------------
4601 subroutine eback_sc_corr(esccor)
4602 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4603 c conformational states; temporarily implemented as differences
4604 c between UNRES torsional potentials (dependent on three types of
4605 c residues) and the torsional potentials dependent on all 20 types
4606 c of residues computed from AM1 energy surfaces of terminally-blocked
4607 c amino-acid residues.
4608 implicit real*8 (a-h,o-z)
4609 include 'DIMENSIONS'
4610 include 'DIMENSIONS.ZSCOPT'
4611 include 'COMMON.VAR'
4612 include 'COMMON.GEO'
4613 include 'COMMON.LOCAL'
4614 include 'COMMON.TORSION'
4615 include 'COMMON.SCCOR'
4616 include 'COMMON.INTERACT'
4617 include 'COMMON.DERIV'
4618 include 'COMMON.CHAIN'
4619 include 'COMMON.NAMES'
4620 include 'COMMON.IOUNITS'
4621 include 'COMMON.FFIELD'
4622 include 'COMMON.CONTROL'
4624 C Set lprn=.true. for debugging
4627 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4629 do i=itau_start,itau_end
4630 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4632 isccori=isccortyp(itype(i-2))
4633 isccori1=isccortyp(itype(i-1))
4635 do intertyp=1,3 !intertyp
4636 cc Added 09 May 2012 (Adasko)
4637 cc Intertyp means interaction type of backbone mainchain correlation:
4638 c 1 = SC...Ca...Ca...Ca
4639 c 2 = Ca...Ca...Ca...SC
4640 c 3 = SC...Ca...Ca...SCi
4642 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4643 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4644 & (itype(i-1).eq.ntyp1)))
4645 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4646 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4647 & .or.(itype(i).eq.ntyp1)))
4648 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4649 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4650 & (itype(i-3).eq.ntyp1)))) cycle
4651 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4652 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4654 do j=1,nterm_sccor(isccori,isccori1)
4655 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4656 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4657 cosphi=dcos(j*tauangle(intertyp,i))
4658 sinphi=dsin(j*tauangle(intertyp,i))
4659 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4660 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4662 write (iout,*)"EBACK_SC_COR",esccor,i
4663 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4664 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4665 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4667 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4668 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4669 & (v1sccor(j,1,itori,itori1),j=1,6)
4670 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4671 c gsccor_loc(i-3)=gloci
4676 c------------------------------------------------------------------------------
4677 subroutine multibody(ecorr)
4678 C This subroutine calculates multi-body contributions to energy following
4679 C the idea of Skolnick et al. If side chains I and J make a contact and
4680 C at the same time side chains I+1 and J+1 make a contact, an extra
4681 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4682 implicit real*8 (a-h,o-z)
4683 include 'DIMENSIONS'
4684 include 'COMMON.IOUNITS'
4685 include 'COMMON.DERIV'
4686 include 'COMMON.INTERACT'
4687 include 'COMMON.CONTACTS'
4688 double precision gx(3),gx1(3)
4691 C Set lprn=.true. for debugging
4695 write (iout,'(a)') 'Contact function values:'
4697 write (iout,'(i2,20(1x,i2,f10.5))')
4698 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4713 num_conti=num_cont(i)
4714 num_conti1=num_cont(i1)
4719 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4720 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4721 cd & ' ishift=',ishift
4722 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4723 C The system gains extra energy.
4724 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4725 endif ! j1==j+-ishift
4734 c------------------------------------------------------------------------------
4735 double precision function esccorr(i,j,k,l,jj,kk)
4736 implicit real*8 (a-h,o-z)
4737 include 'DIMENSIONS'
4738 include 'COMMON.IOUNITS'
4739 include 'COMMON.DERIV'
4740 include 'COMMON.INTERACT'
4741 include 'COMMON.CONTACTS'
4742 double precision gx(3),gx1(3)
4747 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4748 C Calculate the multi-body contribution to energy.
4749 C Calculate multi-body contributions to the gradient.
4750 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4751 cd & k,l,(gacont(m,kk,k),m=1,3)
4753 gx(m) =ekl*gacont(m,jj,i)
4754 gx1(m)=eij*gacont(m,kk,k)
4755 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4756 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4757 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4758 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4762 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4767 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4773 c------------------------------------------------------------------------------
4775 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4776 implicit real*8 (a-h,o-z)
4777 include 'DIMENSIONS'
4778 integer dimen1,dimen2,atom,indx
4779 double precision buffer(dimen1,dimen2)
4780 double precision zapas
4781 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4782 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
4783 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4784 num_kont=num_cont_hb(atom)
4788 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4791 buffer(i,indx+22)=facont_hb(i,atom)
4792 buffer(i,indx+23)=ees0p(i,atom)
4793 buffer(i,indx+24)=ees0m(i,atom)
4794 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4796 buffer(1,indx+26)=dfloat(num_kont)
4799 c------------------------------------------------------------------------------
4800 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4801 implicit real*8 (a-h,o-z)
4802 include 'DIMENSIONS'
4803 integer dimen1,dimen2,atom,indx
4804 double precision buffer(dimen1,dimen2)
4805 double precision zapas
4806 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4807 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
4808 & ees0m(ntyp,maxres),
4809 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4810 num_kont=buffer(1,indx+26)
4811 num_kont_old=num_cont_hb(atom)
4812 num_cont_hb(atom)=num_kont+num_kont_old
4817 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4820 facont_hb(ii,atom)=buffer(i,indx+22)
4821 ees0p(ii,atom)=buffer(i,indx+23)
4822 ees0m(ii,atom)=buffer(i,indx+24)
4823 jcont_hb(ii,atom)=buffer(i,indx+25)
4827 c------------------------------------------------------------------------------
4829 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4830 C This subroutine calculates multi-body contributions to hydrogen-bonding
4831 implicit real*8 (a-h,o-z)
4832 include 'DIMENSIONS'
4833 include 'DIMENSIONS.ZSCOPT'
4834 include 'COMMON.IOUNITS'
4836 include 'COMMON.INFO'
4838 include 'COMMON.FFIELD'
4839 include 'COMMON.DERIV'
4840 include 'COMMON.INTERACT'
4841 include 'COMMON.CONTACTS'
4843 parameter (max_cont=maxconts)
4844 parameter (max_dim=2*(8*3+2))
4845 parameter (msglen1=max_cont*max_dim*4)
4846 parameter (msglen2=2*msglen1)
4847 integer source,CorrelType,CorrelID,Error
4848 double precision buffer(max_cont,max_dim)
4850 double precision gx(3),gx1(3)
4853 C Set lprn=.true. for debugging
4858 if (fgProcs.le.1) goto 30
4860 write (iout,'(a)') 'Contact function values:'
4862 write (iout,'(2i3,50(1x,i2,f5.2))')
4863 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4864 & j=1,num_cont_hb(i))
4867 C Caution! Following code assumes that electrostatic interactions concerning
4868 C a given atom are split among at most two processors!
4878 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4881 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4882 if (MyRank.gt.0) then
4883 C Send correlation contributions to the preceding processor
4885 nn=num_cont_hb(iatel_s)
4886 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4887 cd write (iout,*) 'The BUFFER array:'
4889 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4891 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4893 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4894 C Clear the contacts of the atom passed to the neighboring processor
4895 nn=num_cont_hb(iatel_s+1)
4897 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4899 num_cont_hb(iatel_s)=0
4901 cd write (iout,*) 'Processor ',MyID,MyRank,
4902 cd & ' is sending correlation contribution to processor',MyID-1,
4903 cd & ' msglen=',msglen
4904 cd write (*,*) 'Processor ',MyID,MyRank,
4905 cd & ' is sending correlation contribution to processor',MyID-1,
4906 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4907 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4908 cd write (iout,*) 'Processor ',MyID,
4909 cd & ' has sent correlation contribution to processor',MyID-1,
4910 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4911 cd write (*,*) 'Processor ',MyID,
4912 cd & ' has sent correlation contribution to processor',MyID-1,
4913 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4915 endif ! (MyRank.gt.0)
4919 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4920 if (MyRank.lt.fgProcs-1) then
4921 C Receive correlation contributions from the next processor
4923 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4924 cd write (iout,*) 'Processor',MyID,
4925 cd & ' is receiving correlation contribution from processor',MyID+1,
4926 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4927 cd write (*,*) 'Processor',MyID,
4928 cd & ' is receiving correlation contribution from processor',MyID+1,
4929 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4931 do while (nbytes.le.0)
4932 call mp_probe(MyID+1,CorrelType,nbytes)
4934 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4935 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4936 cd write (iout,*) 'Processor',MyID,
4937 cd & ' has received correlation contribution from processor',MyID+1,
4938 cd & ' msglen=',msglen,' nbytes=',nbytes
4939 cd write (iout,*) 'The received BUFFER array:'
4941 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4943 if (msglen.eq.msglen1) then
4944 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4945 else if (msglen.eq.msglen2) then
4946 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4947 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4950 & 'ERROR!!!! message length changed while processing correlations.'
4952 & 'ERROR!!!! message length changed while processing correlations.'
4953 call mp_stopall(Error)
4954 endif ! msglen.eq.msglen1
4955 endif ! MyRank.lt.fgProcs-1
4962 write (iout,'(a)') 'Contact function values:'
4964 write (iout,'(2i3,50(1x,i2,f5.2))')
4965 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4966 & j=1,num_cont_hb(i))
4970 C Remove the loop below after debugging !!!
4977 C Calculate the local-electrostatic correlation terms
4978 do i=iatel_s,iatel_e+1
4980 num_conti=num_cont_hb(i)
4981 num_conti1=num_cont_hb(i+1)
4986 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4987 c & ' jj=',jj,' kk=',kk
4988 if (j1.eq.j+1 .or. j1.eq.j-1) then
4989 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4990 C The system gains extra energy.
4991 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4993 else if (j1.eq.j) then
4994 C Contacts I-J and I-(J+1) occur simultaneously.
4995 C The system loses extra energy.
4996 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5001 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5002 c & ' jj=',jj,' kk=',kk
5004 C Contacts I-J and (I+1)-J occur simultaneously.
5005 C The system loses extra energy.
5006 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5013 c------------------------------------------------------------------------------
5014 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5016 C This subroutine calculates multi-body contributions to hydrogen-bonding
5017 implicit real*8 (a-h,o-z)
5018 include 'DIMENSIONS'
5019 include 'DIMENSIONS.ZSCOPT'
5020 include 'COMMON.IOUNITS'
5022 include 'COMMON.INFO'
5024 include 'COMMON.FFIELD'
5025 include 'COMMON.DERIV'
5026 include 'COMMON.INTERACT'
5027 include 'COMMON.CONTACTS'
5029 parameter (max_cont=maxconts)
5030 parameter (max_dim=2*(8*3+2))
5031 parameter (msglen1=max_cont*max_dim*4)
5032 parameter (msglen2=2*msglen1)
5033 integer source,CorrelType,CorrelID,Error
5034 double precision buffer(max_cont,max_dim)
5036 double precision gx(3),gx1(3)
5039 C Set lprn=.true. for debugging
5045 if (fgProcs.le.1) goto 30
5047 write (iout,'(a)') 'Contact function values:'
5049 write (iout,'(2i3,50(1x,i2,f5.2))')
5050 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5051 & j=1,num_cont_hb(i))
5054 C Caution! Following code assumes that electrostatic interactions concerning
5055 C a given atom are split among at most two processors!
5065 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5068 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5069 if (MyRank.gt.0) then
5070 C Send correlation contributions to the preceding processor
5072 nn=num_cont_hb(iatel_s)
5073 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5074 cd write (iout,*) 'The BUFFER array:'
5076 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5078 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5080 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5081 C Clear the contacts of the atom passed to the neighboring processor
5082 nn=num_cont_hb(iatel_s+1)
5084 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5086 num_cont_hb(iatel_s)=0
5088 cd write (iout,*) 'Processor ',MyID,MyRank,
5089 cd & ' is sending correlation contribution to processor',MyID-1,
5090 cd & ' msglen=',msglen
5091 cd write (*,*) 'Processor ',MyID,MyRank,
5092 cd & ' is sending correlation contribution to processor',MyID-1,
5093 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5094 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5095 cd write (iout,*) 'Processor ',MyID,
5096 cd & ' has sent correlation contribution to processor',MyID-1,
5097 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5098 cd write (*,*) 'Processor ',MyID,
5099 cd & ' has sent correlation contribution to processor',MyID-1,
5100 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5102 endif ! (MyRank.gt.0)
5106 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5107 if (MyRank.lt.fgProcs-1) then
5108 C Receive correlation contributions from the next processor
5110 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5111 cd write (iout,*) 'Processor',MyID,
5112 cd & ' is receiving correlation contribution from processor',MyID+1,
5113 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5114 cd write (*,*) 'Processor',MyID,
5115 cd & ' is receiving correlation contribution from processor',MyID+1,
5116 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5118 do while (nbytes.le.0)
5119 call mp_probe(MyID+1,CorrelType,nbytes)
5121 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5122 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5123 cd write (iout,*) 'Processor',MyID,
5124 cd & ' has received correlation contribution from processor',MyID+1,
5125 cd & ' msglen=',msglen,' nbytes=',nbytes
5126 cd write (iout,*) 'The received BUFFER array:'
5128 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5130 if (msglen.eq.msglen1) then
5131 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5132 else if (msglen.eq.msglen2) then
5133 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5134 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5137 & 'ERROR!!!! message length changed while processing correlations.'
5139 & 'ERROR!!!! message length changed while processing correlations.'
5140 call mp_stopall(Error)
5141 endif ! msglen.eq.msglen1
5142 endif ! MyRank.lt.fgProcs-1
5149 write (iout,'(a)') 'Contact function values:'
5151 write (iout,'(2i3,50(1x,i2,f5.2))')
5152 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5153 & j=1,num_cont_hb(i))
5159 C Remove the loop below after debugging !!!
5166 C Calculate the dipole-dipole interaction energies
5167 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5168 do i=iatel_s,iatel_e+1
5169 num_conti=num_cont_hb(i)
5176 C Calculate the local-electrostatic correlation terms
5177 do i=iatel_s,iatel_e+1
5179 num_conti=num_cont_hb(i)
5180 num_conti1=num_cont_hb(i+1)
5185 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5186 c & ' jj=',jj,' kk=',kk
5187 if (j1.eq.j+1 .or. j1.eq.j-1) then
5188 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5189 C The system gains extra energy.
5191 sqd1=dsqrt(d_cont(jj,i))
5192 sqd2=dsqrt(d_cont(kk,i1))
5193 sred_geom = sqd1*sqd2
5194 IF (sred_geom.lt.cutoff_corr) THEN
5195 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5197 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5198 c & ' jj=',jj,' kk=',kk
5199 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5200 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5202 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5203 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5206 cd write (iout,*) 'sred_geom=',sred_geom,
5207 cd & ' ekont=',ekont,' fprim=',fprimcont
5208 call calc_eello(i,j,i+1,j1,jj,kk)
5209 if (wcorr4.gt.0.0d0)
5210 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5211 if (wcorr5.gt.0.0d0)
5212 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5213 c print *,"wcorr5",ecorr5
5214 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5215 cd write(2,*)'ijkl',i,j,i+1,j1
5216 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5217 & .or. wturn6.eq.0.0d0))then
5218 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5219 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5220 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5221 cd & 'ecorr6=',ecorr6
5222 cd write (iout,'(4e15.5)') sred_geom,
5223 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5224 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5225 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5226 else if (wturn6.gt.0.0d0
5227 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5228 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5229 eturn6=eturn6+eello_turn6(i,jj,kk)
5230 cd write (2,*) 'multibody_eello:eturn6',eturn6
5234 else if (j1.eq.j) then
5235 C Contacts I-J and I-(J+1) occur simultaneously.
5236 C The system loses extra energy.
5237 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5242 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5243 c & ' jj=',jj,' kk=',kk
5245 C Contacts I-J and (I+1)-J occur simultaneously.
5246 C The system loses extra energy.
5247 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5254 c------------------------------------------------------------------------------
5255 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5256 implicit real*8 (a-h,o-z)
5257 include 'DIMENSIONS'
5258 include 'COMMON.IOUNITS'
5259 include 'COMMON.DERIV'
5260 include 'COMMON.INTERACT'
5261 include 'COMMON.CONTACTS'
5262 double precision gx(3),gx1(3)
5272 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5273 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5274 C Following 4 lines for diagnostics.
5279 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5281 c write (iout,*)'Contacts have occurred for peptide groups',
5282 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5283 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5284 C Calculate the multi-body contribution to energy.
5285 ecorr=ecorr+ekont*ees
5287 C Calculate multi-body contributions to the gradient.
5289 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5290 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5291 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5292 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5293 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5294 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5295 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5296 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5297 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5298 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5299 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5300 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5301 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5302 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5306 gradcorr(ll,m)=gradcorr(ll,m)+
5307 & ees*ekl*gacont_hbr(ll,jj,i)-
5308 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5309 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5314 gradcorr(ll,m)=gradcorr(ll,m)+
5315 & ees*eij*gacont_hbr(ll,kk,k)-
5316 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5317 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5324 C---------------------------------------------------------------------------
5325 subroutine dipole(i,j,jj)
5326 implicit real*8 (a-h,o-z)
5327 include 'DIMENSIONS'
5328 include 'DIMENSIONS.ZSCOPT'
5329 include 'COMMON.IOUNITS'
5330 include 'COMMON.CHAIN'
5331 include 'COMMON.FFIELD'
5332 include 'COMMON.DERIV'
5333 include 'COMMON.INTERACT'
5334 include 'COMMON.CONTACTS'
5335 include 'COMMON.TORSION'
5336 include 'COMMON.VAR'
5337 include 'COMMON.GEO'
5338 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5340 iti1 = itortyp(itype(i+1))
5341 if (j.lt.nres-1) then
5342 if (itype(j).le.ntyp) then
5343 itj1 = itortyp(itype(j+1))
5351 dipi(iii,1)=Ub2(iii,i)
5352 dipderi(iii)=Ub2der(iii,i)
5353 dipi(iii,2)=b1(iii,iti1)
5354 dipj(iii,1)=Ub2(iii,j)
5355 dipderj(iii)=Ub2der(iii,j)
5356 dipj(iii,2)=b1(iii,itj1)
5360 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5363 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5366 if (.not.calc_grad) return
5371 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5375 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5380 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5381 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5383 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5385 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5387 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5391 C---------------------------------------------------------------------------
5392 subroutine calc_eello(i,j,k,l,jj,kk)
5394 C This subroutine computes matrices and vectors needed to calculate
5395 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5397 implicit real*8 (a-h,o-z)
5398 include 'DIMENSIONS'
5399 include 'DIMENSIONS.ZSCOPT'
5400 include 'COMMON.IOUNITS'
5401 include 'COMMON.CHAIN'
5402 include 'COMMON.DERIV'
5403 include 'COMMON.INTERACT'
5404 include 'COMMON.CONTACTS'
5405 include 'COMMON.TORSION'
5406 include 'COMMON.VAR'
5407 include 'COMMON.GEO'
5408 include 'COMMON.FFIELD'
5409 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5410 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5413 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5414 cd & ' jj=',jj,' kk=',kk
5415 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5418 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5419 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5422 call transpose2(aa1(1,1),aa1t(1,1))
5423 call transpose2(aa2(1,1),aa2t(1,1))
5426 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5427 & aa1tder(1,1,lll,kkk))
5428 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5429 & aa2tder(1,1,lll,kkk))
5433 C parallel orientation of the two CA-CA-CA frames.
5434 if (i.gt.1 .and. itype(i).le.ntyp) then
5435 iti=itortyp(itype(i))
5439 itk1=itortyp(itype(k+1))
5440 itj=itortyp(itype(j))
5441 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5442 itl1=itortyp(itype(l+1))
5446 C A1 kernel(j+1) A2T
5448 cd write (iout,'(3f10.5,5x,3f10.5)')
5449 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5451 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5452 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5453 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5454 C Following matrices are needed only for 6-th order cumulants
5455 IF (wcorr6.gt.0.0d0) THEN
5456 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5457 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5458 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5459 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5460 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5461 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5462 & ADtEAderx(1,1,1,1,1,1))
5464 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5465 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5466 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5467 & ADtEA1derx(1,1,1,1,1,1))
5469 C End 6-th order cumulants
5472 cd write (2,*) 'In calc_eello6'
5474 cd write (2,*) 'iii=',iii
5476 cd write (2,*) 'kkk=',kkk
5478 cd write (2,'(3(2f10.5),5x)')
5479 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5484 call transpose2(EUgder(1,1,k),auxmat(1,1))
5485 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5486 call transpose2(EUg(1,1,k),auxmat(1,1))
5487 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5488 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5492 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5493 & EAEAderx(1,1,lll,kkk,iii,1))
5497 C A1T kernel(i+1) A2
5498 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5499 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5500 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5501 C Following matrices are needed only for 6-th order cumulants
5502 IF (wcorr6.gt.0.0d0) THEN
5503 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5504 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5505 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5506 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5507 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5508 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5509 & ADtEAderx(1,1,1,1,1,2))
5510 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5511 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5512 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5513 & ADtEA1derx(1,1,1,1,1,2))
5515 C End 6-th order cumulants
5516 call transpose2(EUgder(1,1,l),auxmat(1,1))
5517 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5518 call transpose2(EUg(1,1,l),auxmat(1,1))
5519 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5520 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5524 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5525 & EAEAderx(1,1,lll,kkk,iii,2))
5530 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5531 C They are needed only when the fifth- or the sixth-order cumulants are
5533 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5534 call transpose2(AEA(1,1,1),auxmat(1,1))
5535 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5536 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5537 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5538 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5539 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5540 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5541 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5542 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5543 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5544 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5545 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5546 call transpose2(AEA(1,1,2),auxmat(1,1))
5547 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5548 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5549 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5550 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5551 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5552 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5553 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5554 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5555 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5556 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5557 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5558 C Calculate the Cartesian derivatives of the vectors.
5562 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5563 call matvec2(auxmat(1,1),b1(1,iti),
5564 & AEAb1derx(1,lll,kkk,iii,1,1))
5565 call matvec2(auxmat(1,1),Ub2(1,i),
5566 & AEAb2derx(1,lll,kkk,iii,1,1))
5567 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5568 & AEAb1derx(1,lll,kkk,iii,2,1))
5569 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5570 & AEAb2derx(1,lll,kkk,iii,2,1))
5571 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5572 call matvec2(auxmat(1,1),b1(1,itj),
5573 & AEAb1derx(1,lll,kkk,iii,1,2))
5574 call matvec2(auxmat(1,1),Ub2(1,j),
5575 & AEAb2derx(1,lll,kkk,iii,1,2))
5576 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5577 & AEAb1derx(1,lll,kkk,iii,2,2))
5578 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5579 & AEAb2derx(1,lll,kkk,iii,2,2))
5586 C Antiparallel orientation of the two CA-CA-CA frames.
5587 if (i.gt.1 .and. itype(i).le.ntyp) then
5588 iti=itortyp(itype(i))
5592 itk1=itortyp(itype(k+1))
5593 itl=itortyp(itype(l))
5594 itj=itortyp(itype(j))
5595 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5596 itj1=itortyp(itype(j+1))
5600 C A2 kernel(j-1)T A1T
5601 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5602 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5603 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5604 C Following matrices are needed only for 6-th order cumulants
5605 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5606 & j.eq.i+4 .and. l.eq.i+3)) THEN
5607 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5608 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5609 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5610 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5611 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5612 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5613 & ADtEAderx(1,1,1,1,1,1))
5614 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5615 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5616 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5617 & ADtEA1derx(1,1,1,1,1,1))
5619 C End 6-th order cumulants
5620 call transpose2(EUgder(1,1,k),auxmat(1,1))
5621 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5622 call transpose2(EUg(1,1,k),auxmat(1,1))
5623 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5624 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5628 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5629 & EAEAderx(1,1,lll,kkk,iii,1))
5633 C A2T kernel(i+1)T A1
5634 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5635 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5636 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5637 C Following matrices are needed only for 6-th order cumulants
5638 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5639 & j.eq.i+4 .and. l.eq.i+3)) THEN
5640 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5641 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5642 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5643 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5644 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5645 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5646 & ADtEAderx(1,1,1,1,1,2))
5647 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5648 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5649 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5650 & ADtEA1derx(1,1,1,1,1,2))
5652 C End 6-th order cumulants
5653 call transpose2(EUgder(1,1,j),auxmat(1,1))
5654 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5655 call transpose2(EUg(1,1,j),auxmat(1,1))
5656 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5657 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5661 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5662 & EAEAderx(1,1,lll,kkk,iii,2))
5667 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5668 C They are needed only when the fifth- or the sixth-order cumulants are
5670 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5671 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5672 call transpose2(AEA(1,1,1),auxmat(1,1))
5673 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5674 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5675 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5676 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5677 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5678 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5679 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5680 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5681 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5682 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5683 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5684 call transpose2(AEA(1,1,2),auxmat(1,1))
5685 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5686 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5687 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5688 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5689 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5690 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5691 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5692 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5693 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5694 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5695 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5696 C Calculate the Cartesian derivatives of the vectors.
5700 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5701 call matvec2(auxmat(1,1),b1(1,iti),
5702 & AEAb1derx(1,lll,kkk,iii,1,1))
5703 call matvec2(auxmat(1,1),Ub2(1,i),
5704 & AEAb2derx(1,lll,kkk,iii,1,1))
5705 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5706 & AEAb1derx(1,lll,kkk,iii,2,1))
5707 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5708 & AEAb2derx(1,lll,kkk,iii,2,1))
5709 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5710 call matvec2(auxmat(1,1),b1(1,itl),
5711 & AEAb1derx(1,lll,kkk,iii,1,2))
5712 call matvec2(auxmat(1,1),Ub2(1,l),
5713 & AEAb2derx(1,lll,kkk,iii,1,2))
5714 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5715 & AEAb1derx(1,lll,kkk,iii,2,2))
5716 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5717 & AEAb2derx(1,lll,kkk,iii,2,2))
5726 C---------------------------------------------------------------------------
5727 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5728 & KK,KKderg,AKA,AKAderg,AKAderx)
5732 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5733 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5734 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5739 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5741 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5744 cd if (lprn) write (2,*) 'In kernel'
5746 cd if (lprn) write (2,*) 'kkk=',kkk
5748 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5749 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5751 cd write (2,*) 'lll=',lll
5752 cd write (2,*) 'iii=1'
5754 cd write (2,'(3(2f10.5),5x)')
5755 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5758 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5759 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5761 cd write (2,*) 'lll=',lll
5762 cd write (2,*) 'iii=2'
5764 cd write (2,'(3(2f10.5),5x)')
5765 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5772 C---------------------------------------------------------------------------
5773 double precision function eello4(i,j,k,l,jj,kk)
5774 implicit real*8 (a-h,o-z)
5775 include 'DIMENSIONS'
5776 include 'DIMENSIONS.ZSCOPT'
5777 include 'COMMON.IOUNITS'
5778 include 'COMMON.CHAIN'
5779 include 'COMMON.DERIV'
5780 include 'COMMON.INTERACT'
5781 include 'COMMON.CONTACTS'
5782 include 'COMMON.TORSION'
5783 include 'COMMON.VAR'
5784 include 'COMMON.GEO'
5785 double precision pizda(2,2),ggg1(3),ggg2(3)
5786 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5790 cd print *,'eello4:',i,j,k,l,jj,kk
5791 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5792 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5793 cold eij=facont_hb(jj,i)
5794 cold ekl=facont_hb(kk,k)
5796 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5798 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5799 gcorr_loc(k-1)=gcorr_loc(k-1)
5800 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5802 gcorr_loc(l-1)=gcorr_loc(l-1)
5803 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5805 gcorr_loc(j-1)=gcorr_loc(j-1)
5806 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5811 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5812 & -EAEAderx(2,2,lll,kkk,iii,1)
5813 cd derx(lll,kkk,iii)=0.0d0
5817 cd gcorr_loc(l-1)=0.0d0
5818 cd gcorr_loc(j-1)=0.0d0
5819 cd gcorr_loc(k-1)=0.0d0
5821 cd write (iout,*)'Contacts have occurred for peptide groups',
5822 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5823 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5824 if (j.lt.nres-1) then
5831 if (l.lt.nres-1) then
5839 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5840 ggg1(ll)=eel4*g_contij(ll,1)
5841 ggg2(ll)=eel4*g_contij(ll,2)
5842 ghalf=0.5d0*ggg1(ll)
5844 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5845 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5846 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5847 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5848 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5849 ghalf=0.5d0*ggg2(ll)
5851 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5852 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5853 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5854 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5859 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5860 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5865 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5866 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5872 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5877 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5881 cd write (2,*) iii,gcorr_loc(iii)
5885 cd write (2,*) 'ekont',ekont
5886 cd write (iout,*) 'eello4',ekont*eel4
5889 C---------------------------------------------------------------------------
5890 double precision function eello5(i,j,k,l,jj,kk)
5891 implicit real*8 (a-h,o-z)
5892 include 'DIMENSIONS'
5893 include 'DIMENSIONS.ZSCOPT'
5894 include 'COMMON.IOUNITS'
5895 include 'COMMON.CHAIN'
5896 include 'COMMON.DERIV'
5897 include 'COMMON.INTERACT'
5898 include 'COMMON.CONTACTS'
5899 include 'COMMON.TORSION'
5900 include 'COMMON.VAR'
5901 include 'COMMON.GEO'
5902 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5903 double precision ggg1(3),ggg2(3)
5904 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5909 C /l\ / \ \ / \ / \ / C
5910 C / \ / \ \ / \ / \ / C
5911 C j| o |l1 | o | o| o | | o |o C
5912 C \ |/k\| |/ \| / |/ \| |/ \| C
5913 C \i/ \ / \ / / \ / \ C
5915 C (I) (II) (III) (IV) C
5917 C eello5_1 eello5_2 eello5_3 eello5_4 C
5919 C Antiparallel chains C
5922 C /j\ / \ \ / \ / \ / C
5923 C / \ / \ \ / \ / \ / C
5924 C j1| o |l | o | o| o | | o |o C
5925 C \ |/k\| |/ \| / |/ \| |/ \| C
5926 C \i/ \ / \ / / \ / \ C
5928 C (I) (II) (III) (IV) C
5930 C eello5_1 eello5_2 eello5_3 eello5_4 C
5932 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5934 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5935 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5940 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5942 itk=itortyp(itype(k))
5943 itl=itortyp(itype(l))
5944 itj=itortyp(itype(j))
5949 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5950 cd & eel5_3_num,eel5_4_num)
5954 derx(lll,kkk,iii)=0.0d0
5958 cd eij=facont_hb(jj,i)
5959 cd ekl=facont_hb(kk,k)
5961 cd write (iout,*)'Contacts have occurred for peptide groups',
5962 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5964 C Contribution from the graph I.
5965 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5966 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5967 call transpose2(EUg(1,1,k),auxmat(1,1))
5968 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5969 vv(1)=pizda(1,1)-pizda(2,2)
5970 vv(2)=pizda(1,2)+pizda(2,1)
5971 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5972 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5974 C Explicit gradient in virtual-dihedral angles.
5975 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5976 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5977 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5978 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5979 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5980 vv(1)=pizda(1,1)-pizda(2,2)
5981 vv(2)=pizda(1,2)+pizda(2,1)
5982 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5983 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5984 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5985 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5986 vv(1)=pizda(1,1)-pizda(2,2)
5987 vv(2)=pizda(1,2)+pizda(2,1)
5989 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5990 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5991 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5993 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5994 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5995 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5997 C Cartesian gradient
6001 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6003 vv(1)=pizda(1,1)-pizda(2,2)
6004 vv(2)=pizda(1,2)+pizda(2,1)
6005 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6006 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6007 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6014 C Contribution from graph II
6015 call transpose2(EE(1,1,itk),auxmat(1,1))
6016 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6017 vv(1)=pizda(1,1)+pizda(2,2)
6018 vv(2)=pizda(2,1)-pizda(1,2)
6019 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6020 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6022 C Explicit gradient in virtual-dihedral angles.
6023 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6024 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6025 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6026 vv(1)=pizda(1,1)+pizda(2,2)
6027 vv(2)=pizda(2,1)-pizda(1,2)
6029 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6030 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6031 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6033 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6034 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6035 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6037 C Cartesian gradient
6041 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6043 vv(1)=pizda(1,1)+pizda(2,2)
6044 vv(2)=pizda(2,1)-pizda(1,2)
6045 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6046 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6047 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6056 C Parallel orientation
6057 C Contribution from graph III
6058 call transpose2(EUg(1,1,l),auxmat(1,1))
6059 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6060 vv(1)=pizda(1,1)-pizda(2,2)
6061 vv(2)=pizda(1,2)+pizda(2,1)
6062 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6063 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6065 C Explicit gradient in virtual-dihedral angles.
6066 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6067 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6068 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6069 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6070 vv(1)=pizda(1,1)-pizda(2,2)
6071 vv(2)=pizda(1,2)+pizda(2,1)
6072 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6073 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6074 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6075 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6076 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6077 vv(1)=pizda(1,1)-pizda(2,2)
6078 vv(2)=pizda(1,2)+pizda(2,1)
6079 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6080 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6081 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6082 C Cartesian gradient
6086 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6088 vv(1)=pizda(1,1)-pizda(2,2)
6089 vv(2)=pizda(1,2)+pizda(2,1)
6090 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6091 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6092 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6098 C Contribution from graph IV
6100 call transpose2(EE(1,1,itl),auxmat(1,1))
6101 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6102 vv(1)=pizda(1,1)+pizda(2,2)
6103 vv(2)=pizda(2,1)-pizda(1,2)
6104 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6105 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6107 C Explicit gradient in virtual-dihedral angles.
6108 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6109 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6110 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6111 vv(1)=pizda(1,1)+pizda(2,2)
6112 vv(2)=pizda(2,1)-pizda(1,2)
6113 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6114 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6115 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6116 C Cartesian gradient
6120 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6122 vv(1)=pizda(1,1)+pizda(2,2)
6123 vv(2)=pizda(2,1)-pizda(1,2)
6124 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6125 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6126 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6132 C Antiparallel orientation
6133 C Contribution from graph III
6135 call transpose2(EUg(1,1,j),auxmat(1,1))
6136 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6137 vv(1)=pizda(1,1)-pizda(2,2)
6138 vv(2)=pizda(1,2)+pizda(2,1)
6139 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6140 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6142 C Explicit gradient in virtual-dihedral angles.
6143 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6144 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6145 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6146 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6147 vv(1)=pizda(1,1)-pizda(2,2)
6148 vv(2)=pizda(1,2)+pizda(2,1)
6149 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6150 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6151 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6152 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6153 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6154 vv(1)=pizda(1,1)-pizda(2,2)
6155 vv(2)=pizda(1,2)+pizda(2,1)
6156 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6157 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6158 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6159 C Cartesian gradient
6163 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6165 vv(1)=pizda(1,1)-pizda(2,2)
6166 vv(2)=pizda(1,2)+pizda(2,1)
6167 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6168 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6169 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6175 C Contribution from graph IV
6177 call transpose2(EE(1,1,itj),auxmat(1,1))
6178 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6179 vv(1)=pizda(1,1)+pizda(2,2)
6180 vv(2)=pizda(2,1)-pizda(1,2)
6181 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6182 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6184 C Explicit gradient in virtual-dihedral angles.
6185 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6186 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6187 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6188 vv(1)=pizda(1,1)+pizda(2,2)
6189 vv(2)=pizda(2,1)-pizda(1,2)
6190 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6191 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6192 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6193 C Cartesian gradient
6197 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6199 vv(1)=pizda(1,1)+pizda(2,2)
6200 vv(2)=pizda(2,1)-pizda(1,2)
6201 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6202 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6203 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6210 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6211 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6212 cd write (2,*) 'ijkl',i,j,k,l
6213 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6214 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6216 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6217 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6218 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6219 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6221 if (j.lt.nres-1) then
6228 if (l.lt.nres-1) then
6238 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6240 ggg1(ll)=eel5*g_contij(ll,1)
6241 ggg2(ll)=eel5*g_contij(ll,2)
6242 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6243 ghalf=0.5d0*ggg1(ll)
6245 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6246 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6247 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6248 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6249 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6250 ghalf=0.5d0*ggg2(ll)
6252 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6253 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6254 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6255 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6260 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6261 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6266 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6267 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6273 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6278 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6282 cd write (2,*) iii,g_corr5_loc(iii)
6286 cd write (2,*) 'ekont',ekont
6287 cd write (iout,*) 'eello5',ekont*eel5
6290 c--------------------------------------------------------------------------
6291 double precision function eello6(i,j,k,l,jj,kk)
6292 implicit real*8 (a-h,o-z)
6293 include 'DIMENSIONS'
6294 include 'DIMENSIONS.ZSCOPT'
6295 include 'COMMON.IOUNITS'
6296 include 'COMMON.CHAIN'
6297 include 'COMMON.DERIV'
6298 include 'COMMON.INTERACT'
6299 include 'COMMON.CONTACTS'
6300 include 'COMMON.TORSION'
6301 include 'COMMON.VAR'
6302 include 'COMMON.GEO'
6303 include 'COMMON.FFIELD'
6304 double precision ggg1(3),ggg2(3)
6305 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6310 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6318 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6319 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6323 derx(lll,kkk,iii)=0.0d0
6327 cd eij=facont_hb(jj,i)
6328 cd ekl=facont_hb(kk,k)
6334 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6335 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6336 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6337 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6338 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6339 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6341 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6342 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6343 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6344 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6345 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6346 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6350 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6352 C If turn contributions are considered, they will be handled separately.
6353 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6354 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6355 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6356 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6357 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6358 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6359 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6362 if (j.lt.nres-1) then
6369 if (l.lt.nres-1) then
6377 ggg1(ll)=eel6*g_contij(ll,1)
6378 ggg2(ll)=eel6*g_contij(ll,2)
6379 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6380 ghalf=0.5d0*ggg1(ll)
6382 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6383 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6384 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6385 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6386 ghalf=0.5d0*ggg2(ll)
6387 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6389 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6390 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6391 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6392 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6397 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6398 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6403 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6404 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6410 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6415 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6419 cd write (2,*) iii,g_corr6_loc(iii)
6423 cd write (2,*) 'ekont',ekont
6424 cd write (iout,*) 'eello6',ekont*eel6
6427 c--------------------------------------------------------------------------
6428 double precision function eello6_graph1(i,j,k,l,imat,swap)
6429 implicit real*8 (a-h,o-z)
6430 include 'DIMENSIONS'
6431 include 'DIMENSIONS.ZSCOPT'
6432 include 'COMMON.IOUNITS'
6433 include 'COMMON.CHAIN'
6434 include 'COMMON.DERIV'
6435 include 'COMMON.INTERACT'
6436 include 'COMMON.CONTACTS'
6437 include 'COMMON.TORSION'
6438 include 'COMMON.VAR'
6439 include 'COMMON.GEO'
6440 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6444 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6446 C Parallel Antiparallel C
6452 C \ j|/k\| / \ |/k\|l / C
6457 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6458 itk=itortyp(itype(k))
6459 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6460 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6461 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6462 call transpose2(EUgC(1,1,k),auxmat(1,1))
6463 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6464 vv1(1)=pizda1(1,1)-pizda1(2,2)
6465 vv1(2)=pizda1(1,2)+pizda1(2,1)
6466 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6467 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6468 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6469 s5=scalar2(vv(1),Dtobr2(1,i))
6470 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6471 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6472 if (.not. calc_grad) return
6473 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6474 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6475 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6476 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6477 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6478 & +scalar2(vv(1),Dtobr2der(1,i)))
6479 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6480 vv1(1)=pizda1(1,1)-pizda1(2,2)
6481 vv1(2)=pizda1(1,2)+pizda1(2,1)
6482 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6483 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6485 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6486 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6487 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6488 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6489 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6491 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6492 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6493 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6494 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6495 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6497 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6498 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6499 vv1(1)=pizda1(1,1)-pizda1(2,2)
6500 vv1(2)=pizda1(1,2)+pizda1(2,1)
6501 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6502 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6503 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6504 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6513 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6514 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6515 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6516 call transpose2(EUgC(1,1,k),auxmat(1,1))
6517 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6519 vv1(1)=pizda1(1,1)-pizda1(2,2)
6520 vv1(2)=pizda1(1,2)+pizda1(2,1)
6521 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6522 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6523 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6524 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6525 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6526 s5=scalar2(vv(1),Dtobr2(1,i))
6527 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6533 c----------------------------------------------------------------------------
6534 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6535 implicit real*8 (a-h,o-z)
6536 include 'DIMENSIONS'
6537 include 'DIMENSIONS.ZSCOPT'
6538 include 'COMMON.IOUNITS'
6539 include 'COMMON.CHAIN'
6540 include 'COMMON.DERIV'
6541 include 'COMMON.INTERACT'
6542 include 'COMMON.CONTACTS'
6543 include 'COMMON.TORSION'
6544 include 'COMMON.VAR'
6545 include 'COMMON.GEO'
6547 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6548 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6551 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6553 C Parallel Antiparallel C
6559 C \ j|/k\| \ |/k\|l C
6564 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6565 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6566 C AL 7/4/01 s1 would occur in the sixth-order moment,
6567 C but not in a cluster cumulant
6569 s1=dip(1,jj,i)*dip(1,kk,k)
6571 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6572 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6573 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6574 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6575 call transpose2(EUg(1,1,k),auxmat(1,1))
6576 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6577 vv(1)=pizda(1,1)-pizda(2,2)
6578 vv(2)=pizda(1,2)+pizda(2,1)
6579 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6580 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6582 eello6_graph2=-(s1+s2+s3+s4)
6584 eello6_graph2=-(s2+s3+s4)
6587 if (.not. calc_grad) return
6588 C Derivatives in gamma(i-1)
6591 s1=dipderg(1,jj,i)*dip(1,kk,k)
6593 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6594 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6595 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6596 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6598 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6600 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6602 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6604 C Derivatives in gamma(k-1)
6606 s1=dip(1,jj,i)*dipderg(1,kk,k)
6608 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6609 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6610 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6611 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6612 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6613 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6614 vv(1)=pizda(1,1)-pizda(2,2)
6615 vv(2)=pizda(1,2)+pizda(2,1)
6616 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6618 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6620 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6622 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6623 C Derivatives in gamma(j-1) or gamma(l-1)
6626 s1=dipderg(3,jj,i)*dip(1,kk,k)
6628 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6629 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6630 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6631 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6632 vv(1)=pizda(1,1)-pizda(2,2)
6633 vv(2)=pizda(1,2)+pizda(2,1)
6634 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6637 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6639 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6642 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6643 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6645 C Derivatives in gamma(l-1) or gamma(j-1)
6648 s1=dip(1,jj,i)*dipderg(3,kk,k)
6650 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6651 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6652 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6653 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6654 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6655 vv(1)=pizda(1,1)-pizda(2,2)
6656 vv(2)=pizda(1,2)+pizda(2,1)
6657 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6660 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6662 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6665 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6666 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6668 C Cartesian derivatives.
6670 write (2,*) 'In eello6_graph2'
6672 write (2,*) 'iii=',iii
6674 write (2,*) 'kkk=',kkk
6676 write (2,'(3(2f10.5),5x)')
6677 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6687 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6689 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6692 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6694 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6695 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6697 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6698 call transpose2(EUg(1,1,k),auxmat(1,1))
6699 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6701 vv(1)=pizda(1,1)-pizda(2,2)
6702 vv(2)=pizda(1,2)+pizda(2,1)
6703 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6704 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6706 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6708 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6711 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6713 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6720 c----------------------------------------------------------------------------
6721 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6722 implicit real*8 (a-h,o-z)
6723 include 'DIMENSIONS'
6724 include 'DIMENSIONS.ZSCOPT'
6725 include 'COMMON.IOUNITS'
6726 include 'COMMON.CHAIN'
6727 include 'COMMON.DERIV'
6728 include 'COMMON.INTERACT'
6729 include 'COMMON.CONTACTS'
6730 include 'COMMON.TORSION'
6731 include 'COMMON.VAR'
6732 include 'COMMON.GEO'
6733 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6735 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6737 C Parallel Antiparallel C
6743 C j|/k\| / |/k\|l / C
6748 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6750 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6751 C energy moment and not to the cluster cumulant.
6752 iti=itortyp(itype(i))
6753 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6754 itj1=itortyp(itype(j+1))
6758 itk=itortyp(itype(k))
6759 itk1=itortyp(itype(k+1))
6760 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6761 itl1=itortyp(itype(l+1))
6766 s1=dip(4,jj,i)*dip(4,kk,k)
6768 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6769 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6770 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6771 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6772 call transpose2(EE(1,1,itk),auxmat(1,1))
6773 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6774 vv(1)=pizda(1,1)+pizda(2,2)
6775 vv(2)=pizda(2,1)-pizda(1,2)
6776 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6777 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6779 eello6_graph3=-(s1+s2+s3+s4)
6781 eello6_graph3=-(s2+s3+s4)
6784 if (.not. calc_grad) return
6785 C Derivatives in gamma(k-1)
6786 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6787 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6788 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6789 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6790 C Derivatives in gamma(l-1)
6791 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6792 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6793 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6794 vv(1)=pizda(1,1)+pizda(2,2)
6795 vv(2)=pizda(2,1)-pizda(1,2)
6796 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6797 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6798 C Cartesian derivatives.
6804 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6806 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6809 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6811 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6812 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6814 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6815 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6817 vv(1)=pizda(1,1)+pizda(2,2)
6818 vv(2)=pizda(2,1)-pizda(1,2)
6819 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6821 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6823 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6826 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6828 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6830 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6836 c----------------------------------------------------------------------------
6837 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6838 implicit real*8 (a-h,o-z)
6839 include 'DIMENSIONS'
6840 include 'DIMENSIONS.ZSCOPT'
6841 include 'COMMON.IOUNITS'
6842 include 'COMMON.CHAIN'
6843 include 'COMMON.DERIV'
6844 include 'COMMON.INTERACT'
6845 include 'COMMON.CONTACTS'
6846 include 'COMMON.TORSION'
6847 include 'COMMON.VAR'
6848 include 'COMMON.GEO'
6849 include 'COMMON.FFIELD'
6850 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6851 & auxvec1(2),auxmat1(2,2)
6853 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6855 C Parallel Antiparallel C
6861 C \ j|/k\| \ |/k\|l C
6866 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6868 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6869 C energy moment and not to the cluster cumulant.
6870 cd write (2,*) 'eello_graph4: wturn6',wturn6
6871 iti=itortyp(itype(i))
6872 itj=itortyp(itype(j))
6873 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6874 itj1=itortyp(itype(j+1))
6878 itk=itortyp(itype(k))
6879 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6880 itk1=itortyp(itype(k+1))
6884 itl=itortyp(itype(l))
6885 if (l.lt.nres-1) then
6886 itl1=itortyp(itype(l+1))
6890 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6891 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6892 cd & ' itl',itl,' itl1',itl1
6895 s1=dip(3,jj,i)*dip(3,kk,k)
6897 s1=dip(2,jj,j)*dip(2,kk,l)
6900 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6901 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6903 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6904 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6906 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6907 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6909 call transpose2(EUg(1,1,k),auxmat(1,1))
6910 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6911 vv(1)=pizda(1,1)-pizda(2,2)
6912 vv(2)=pizda(2,1)+pizda(1,2)
6913 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6914 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6916 eello6_graph4=-(s1+s2+s3+s4)
6918 eello6_graph4=-(s2+s3+s4)
6920 if (.not. calc_grad) return
6921 C Derivatives in gamma(i-1)
6925 s1=dipderg(2,jj,i)*dip(3,kk,k)
6927 s1=dipderg(4,jj,j)*dip(2,kk,l)
6930 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6932 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6933 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6935 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6936 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6938 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6939 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6940 cd write (2,*) 'turn6 derivatives'
6942 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6944 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6948 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6950 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6954 C Derivatives in gamma(k-1)
6957 s1=dip(3,jj,i)*dipderg(2,kk,k)
6959 s1=dip(2,jj,j)*dipderg(4,kk,l)
6962 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6963 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6965 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6966 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6968 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6969 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6971 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6972 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6973 vv(1)=pizda(1,1)-pizda(2,2)
6974 vv(2)=pizda(2,1)+pizda(1,2)
6975 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6976 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6978 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6980 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6984 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6986 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6989 C Derivatives in gamma(j-1) or gamma(l-1)
6990 if (l.eq.j+1 .and. l.gt.1) then
6991 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6992 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6993 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6994 vv(1)=pizda(1,1)-pizda(2,2)
6995 vv(2)=pizda(2,1)+pizda(1,2)
6996 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6997 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6998 else if (j.gt.1) then
6999 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7000 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7001 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7002 vv(1)=pizda(1,1)-pizda(2,2)
7003 vv(2)=pizda(2,1)+pizda(1,2)
7004 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7005 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7006 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7008 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7011 C Cartesian derivatives.
7018 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7020 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7024 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7026 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7030 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7032 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7034 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7035 & b1(1,itj1),auxvec(1))
7036 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7038 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7039 & b1(1,itl1),auxvec(1))
7040 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7042 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7044 vv(1)=pizda(1,1)-pizda(2,2)
7045 vv(2)=pizda(2,1)+pizda(1,2)
7046 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7048 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7050 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7053 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7056 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7059 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7061 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7063 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7067 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7069 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7072 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7074 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7082 c----------------------------------------------------------------------------
7083 double precision function eello_turn6(i,jj,kk)
7084 implicit real*8 (a-h,o-z)
7085 include 'DIMENSIONS'
7086 include 'DIMENSIONS.ZSCOPT'
7087 include 'COMMON.IOUNITS'
7088 include 'COMMON.CHAIN'
7089 include 'COMMON.DERIV'
7090 include 'COMMON.INTERACT'
7091 include 'COMMON.CONTACTS'
7092 include 'COMMON.TORSION'
7093 include 'COMMON.VAR'
7094 include 'COMMON.GEO'
7095 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7096 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7098 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7099 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7100 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7101 C the respective energy moment and not to the cluster cumulant.
7106 iti=itortyp(itype(i))
7107 itk=itortyp(itype(k))
7108 itk1=itortyp(itype(k+1))
7109 itl=itortyp(itype(l))
7110 itj=itortyp(itype(j))
7111 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7112 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7113 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7118 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7120 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7124 derx_turn(lll,kkk,iii)=0.0d0
7131 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7133 cd write (2,*) 'eello6_5',eello6_5
7135 call transpose2(AEA(1,1,1),auxmat(1,1))
7136 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7137 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7138 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7142 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7143 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7144 s2 = scalar2(b1(1,itk),vtemp1(1))
7146 call transpose2(AEA(1,1,2),atemp(1,1))
7147 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7148 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7149 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7153 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7154 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7155 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7157 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7158 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7159 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7160 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7161 ss13 = scalar2(b1(1,itk),vtemp4(1))
7162 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7166 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7172 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7174 C Derivatives in gamma(i+2)
7176 call transpose2(AEA(1,1,1),auxmatd(1,1))
7177 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7178 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7179 call transpose2(AEAderg(1,1,2),atempd(1,1))
7180 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7181 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7185 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7186 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7187 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7193 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7194 C Derivatives in gamma(i+3)
7196 call transpose2(AEA(1,1,1),auxmatd(1,1))
7197 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7198 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7199 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7203 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7204 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7205 s2d = scalar2(b1(1,itk),vtemp1d(1))
7207 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7208 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7210 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7212 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7213 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7214 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7224 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7225 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7227 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7228 & -0.5d0*ekont*(s2d+s12d)
7230 C Derivatives in gamma(i+4)
7231 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7232 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7233 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7235 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7236 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7237 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7247 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7249 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7251 C Derivatives in gamma(i+5)
7253 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7254 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7255 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7259 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7260 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7261 s2d = scalar2(b1(1,itk),vtemp1d(1))
7263 call transpose2(AEA(1,1,2),atempd(1,1))
7264 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7265 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7269 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7270 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7272 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7273 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7274 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7284 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7285 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7287 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7288 & -0.5d0*ekont*(s2d+s12d)
7290 C Cartesian derivatives
7295 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7296 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7297 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7301 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7302 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7304 s2d = scalar2(b1(1,itk),vtemp1d(1))
7306 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7307 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7308 s8d = -(atempd(1,1)+atempd(2,2))*
7309 & scalar2(cc(1,1,itl),vtemp2(1))
7313 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7315 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7316 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7323 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7326 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7330 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7331 & - 0.5d0*(s8d+s12d)
7333 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7342 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7344 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7345 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7346 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7347 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7348 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7350 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7351 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7352 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7356 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7357 cd & 16*eel_turn6_num
7359 if (j.lt.nres-1) then
7366 if (l.lt.nres-1) then
7374 ggg1(ll)=eel_turn6*g_contij(ll,1)
7375 ggg2(ll)=eel_turn6*g_contij(ll,2)
7376 ghalf=0.5d0*ggg1(ll)
7378 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7379 & +ekont*derx_turn(ll,2,1)
7380 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7381 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7382 & +ekont*derx_turn(ll,4,1)
7383 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7384 ghalf=0.5d0*ggg2(ll)
7386 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7387 & +ekont*derx_turn(ll,2,2)
7388 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7389 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7390 & +ekont*derx_turn(ll,4,2)
7391 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7396 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7401 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7407 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7412 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7416 cd write (2,*) iii,g_corr6_loc(iii)
7419 eello_turn6=ekont*eel_turn6
7420 cd write (2,*) 'ekont',ekont
7421 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7424 crc-------------------------------------------------
7425 SUBROUTINE MATVEC2(A1,V1,V2)
7426 implicit real*8 (a-h,o-z)
7427 include 'DIMENSIONS'
7428 DIMENSION A1(2,2),V1(2),V2(2)
7432 c 3 VI=VI+A1(I,K)*V1(K)
7436 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7437 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7442 C---------------------------------------
7443 SUBROUTINE MATMAT2(A1,A2,A3)
7444 implicit real*8 (a-h,o-z)
7445 include 'DIMENSIONS'
7446 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7447 c DIMENSION AI3(2,2)
7451 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7457 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7458 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7459 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7460 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7468 c-------------------------------------------------------------------------
7469 double precision function scalar2(u,v)
7471 double precision u(2),v(2)
7474 scalar2=u(1)*v(1)+u(2)*v(2)
7478 C-----------------------------------------------------------------------------
7480 subroutine transpose2(a,at)
7482 double precision a(2,2),at(2,2)
7489 c--------------------------------------------------------------------------
7490 subroutine transpose(n,a,at)
7493 double precision a(n,n),at(n,n)
7501 C---------------------------------------------------------------------------
7502 subroutine prodmat3(a1,a2,kk,transp,prod)
7505 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7507 crc double precision auxmat(2,2),prod_(2,2)
7510 crc call transpose2(kk(1,1),auxmat(1,1))
7511 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7512 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7514 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7515 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7516 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7517 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7518 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7519 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7520 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7521 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7524 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7525 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7527 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7528 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7529 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7530 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7531 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7532 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7533 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7534 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7537 c call transpose2(a2(1,1),a2t(1,1))
7540 crc print *,((prod_(i,j),i=1,2),j=1,2)
7541 crc print *,((prod(i,j),i=1,2),j=1,2)
7545 C-----------------------------------------------------------------------------
7546 double precision function scalar(u,v)
7548 double precision u(3),v(3)