1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
128 energia(2)=evdw2-evdw2_14
145 energia(8)=eello_turn3
146 energia(9)=eello_turn4
155 energia(20)=edihcnstr
160 if (isnan(etot).ne.0) energia(0)=1.0d+99
162 if (isnan(etot)) energia(0)=1.0d+99
167 idumm=proc_proc(etot,i)
169 call proc_proc(etot,i)
171 if(i.eq.1)energia(0)=1.0d+99
178 C Sum up the components of the Cartesian gradient.
183 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
184 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
186 & wstrain*ghpbc(j,i)+
187 & wcorr*fact(3)*gradcorr(j,i)+
188 & wel_loc*fact(2)*gel_loc(j,i)+
189 & wturn3*fact(2)*gcorr3_turn(j,i)+
190 & wturn4*fact(3)*gcorr4_turn(j,i)+
191 & wcorr5*fact(4)*gradcorr5(j,i)+
192 & wcorr6*fact(5)*gradcorr6(j,i)+
193 & wturn6*fact(5)*gcorr6_turn(j,i)+
194 & wsccor*fact(2)*gsccorc(j,i)
195 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
197 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
198 & wsccor*fact(2)*gsccorx(j,i)
203 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
204 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
206 & wcorr*fact(3)*gradcorr(j,i)+
207 & wel_loc*fact(2)*gel_loc(j,i)+
208 & wturn3*fact(2)*gcorr3_turn(j,i)+
209 & wturn4*fact(3)*gcorr4_turn(j,i)+
210 & wcorr5*fact(4)*gradcorr5(j,i)+
211 & wcorr6*fact(5)*gradcorr6(j,i)+
212 & wturn6*fact(5)*gcorr6_turn(j,i)+
213 & wsccor*fact(2)*gsccorc(j,i)
214 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
216 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
217 & wsccor*fact(1)*gsccorx(j,i)
224 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
225 & +wcorr5*fact(4)*g_corr5_loc(i)
226 & +wcorr6*fact(5)*g_corr6_loc(i)
227 & +wturn4*fact(3)*gel_loc_turn4(i)
228 & +wturn3*fact(2)*gel_loc_turn3(i)
229 & +wturn6*fact(5)*gel_loc_turn6(i)
230 & +wel_loc*fact(2)*gel_loc_loc(i)
235 C------------------------------------------------------------------------
236 subroutine enerprint(energia,fact)
237 implicit real*8 (a-h,o-z)
239 include 'DIMENSIONS.ZSCOPT'
240 include 'COMMON.IOUNITS'
241 include 'COMMON.FFIELD'
242 include 'COMMON.SBRIDGE'
243 double precision energia(0:max_ene),fact(6)
245 evdw=energia(1)+fact(6)*energia(21)
247 evdw2=energia(2)+energia(17)
259 eello_turn3=energia(8)
260 eello_turn4=energia(9)
261 eello_turn6=energia(10)
268 edihcnstr=energia(20)
271 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
273 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
274 & etors_d,wtor_d*fact(2),ehpb,wstrain,
275 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
276 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
277 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
278 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
279 10 format (/'Virtual-chain energies:'//
280 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
281 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
282 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
283 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
284 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
285 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
286 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
287 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
288 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
289 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
290 & ' (SS bridges & dist. cnstr.)'/
291 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
292 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
293 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
295 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
296 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
297 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
298 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
299 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
300 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
301 & 'ETOT= ',1pE16.6,' (total)')
303 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
304 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
305 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
306 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
307 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
308 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
309 & edihcnstr,ebr*nss,etot
310 10 format (/'Virtual-chain energies:'//
311 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
312 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
313 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
314 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
315 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
316 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
317 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
318 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
319 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
320 & ' (SS bridges & dist. cnstr.)'/
321 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
322 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
323 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
325 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
326 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
327 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
328 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
329 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
330 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
331 & 'ETOT= ',1pE16.6,' (total)')
335 C-----------------------------------------------------------------------
336 subroutine elj(evdw,evdw_t)
338 C This subroutine calculates the interaction energy of nonbonded side chains
339 C assuming the LJ potential of interaction.
341 implicit real*8 (a-h,o-z)
343 include 'DIMENSIONS.ZSCOPT'
344 include "DIMENSIONS.COMPAR"
345 parameter (accur=1.0d-10)
348 include 'COMMON.LOCAL'
349 include 'COMMON.CHAIN'
350 include 'COMMON.DERIV'
351 include 'COMMON.INTERACT'
352 include 'COMMON.TORSION'
353 include 'COMMON.ENEPS'
354 include 'COMMON.SBRIDGE'
355 include 'COMMON.NAMES'
356 include 'COMMON.IOUNITS'
357 include 'COMMON.CONTACTS'
361 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
364 eneps_temp(j,i)=0.0d0
371 if (itypi.eq.ntyp1) cycle
372 itypi1=iabs(itype(i+1))
379 C Calculate SC interaction energy.
382 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
383 cd & 'iend=',iend(i,iint)
384 do j=istart(i,iint),iend(i,iint)
386 if (itypj.eq.ntyp1) cycle
390 C Change 12/1/95 to calculate four-body interactions
391 rij=xj*xj+yj*yj+zj*zj
393 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
394 eps0ij=eps(itypi,itypj)
396 e1=fac*fac*aa(itypi,itypj)
397 e2=fac*bb(itypi,itypj)
399 ij=icant(itypi,itypj)
400 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
401 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
402 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
403 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
404 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
405 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
406 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
407 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
408 if (bb(itypi,itypj).gt.0.0d0) then
415 C Calculate the components of the gradient in DC and X
417 fac=-rrij*(e1+evdwij)
422 gvdwx(k,i)=gvdwx(k,i)-gg(k)
423 gvdwx(k,j)=gvdwx(k,j)+gg(k)
427 gvdwc(l,k)=gvdwc(l,k)+gg(l)
432 C 12/1/95, revised on 5/20/97
434 C Calculate the contact function. The ith column of the array JCONT will
435 C contain the numbers of atoms that make contacts with the atom I (of numbers
436 C greater than I). The arrays FACONT and GACONT will contain the values of
437 C the contact function and its derivative.
439 C Uncomment next line, if the correlation interactions include EVDW explicitly.
440 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
441 C Uncomment next line, if the correlation interactions are contact function only
442 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
444 sigij=sigma(itypi,itypj)
445 r0ij=rs0(itypi,itypj)
447 C Check whether the SC's are not too far to make a contact.
450 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
451 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
453 if (fcont.gt.0.0D0) then
454 C If the SC-SC distance if close to sigma, apply spline.
455 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
456 cAdam & fcont1,fprimcont1)
457 cAdam fcont1=1.0d0-fcont1
458 cAdam if (fcont1.gt.0.0d0) then
459 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
460 cAdam fcont=fcont*fcont1
462 C Uncomment following 4 lines to have the geometric average of the epsilon0's
463 cga eps0ij=1.0d0/dsqrt(eps0ij)
465 cga gg(k)=gg(k)*eps0ij
467 cga eps0ij=-evdwij*eps0ij
468 C Uncomment for AL's type of SC correlation interactions.
470 num_conti=num_conti+1
472 facont(num_conti,i)=fcont*eps0ij
473 fprimcont=eps0ij*fprimcont/rij
475 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
476 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
477 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
478 C Uncomment following 3 lines for Skolnick's type of SC correlation.
479 gacont(1,num_conti,i)=-fprimcont*xj
480 gacont(2,num_conti,i)=-fprimcont*yj
481 gacont(3,num_conti,i)=-fprimcont*zj
482 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
483 cd write (iout,'(2i3,3f10.5)')
484 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
490 num_cont(i)=num_conti
495 gvdwc(j,i)=expon*gvdwc(j,i)
496 gvdwx(j,i)=expon*gvdwx(j,i)
500 C******************************************************************************
504 C To save time, the factor of EXPON has been extracted from ALL components
505 C of GVDWC and GRADX. Remember to multiply them by this factor before further
508 C******************************************************************************
511 C-----------------------------------------------------------------------------
512 subroutine eljk(evdw,evdw_t)
514 C This subroutine calculates the interaction energy of nonbonded side chains
515 C assuming the LJK potential of interaction.
517 implicit real*8 (a-h,o-z)
519 include 'DIMENSIONS.ZSCOPT'
520 include "DIMENSIONS.COMPAR"
523 include 'COMMON.LOCAL'
524 include 'COMMON.CHAIN'
525 include 'COMMON.DERIV'
526 include 'COMMON.INTERACT'
527 include 'COMMON.ENEPS'
528 include 'COMMON.IOUNITS'
529 include 'COMMON.NAMES'
534 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
537 eneps_temp(j,i)=0.0d0
544 if (itypi.eq.ntyp1) cycle
545 itypi1=iabs(itype(i+1))
550 C Calculate SC interaction energy.
553 do j=istart(i,iint),iend(i,iint)
555 if (itypj.eq.ntyp1) cycle
559 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
561 e_augm=augm(itypi,itypj)*fac_augm
564 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
565 fac=r_shift_inv**expon
566 e1=fac*fac*aa(itypi,itypj)
567 e2=fac*bb(itypi,itypj)
569 ij=icant(itypi,itypj)
570 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
571 & /dabs(eps(itypi,itypj))
572 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
573 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
574 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
575 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
576 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
577 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
578 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
579 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
580 if (bb(itypi,itypj).gt.0.0d0) then
587 C Calculate the components of the gradient in DC and X
589 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
594 gvdwx(k,i)=gvdwx(k,i)-gg(k)
595 gvdwx(k,j)=gvdwx(k,j)+gg(k)
599 gvdwc(l,k)=gvdwc(l,k)+gg(l)
609 gvdwc(j,i)=expon*gvdwc(j,i)
610 gvdwx(j,i)=expon*gvdwx(j,i)
616 C-----------------------------------------------------------------------------
617 subroutine ebp(evdw,evdw_t)
619 C This subroutine calculates the interaction energy of nonbonded side chains
620 C assuming the Berne-Pechukas potential of interaction.
622 implicit real*8 (a-h,o-z)
624 include 'DIMENSIONS.ZSCOPT'
625 include "DIMENSIONS.COMPAR"
628 include 'COMMON.LOCAL'
629 include 'COMMON.CHAIN'
630 include 'COMMON.DERIV'
631 include 'COMMON.NAMES'
632 include 'COMMON.INTERACT'
633 include 'COMMON.ENEPS'
634 include 'COMMON.IOUNITS'
635 include 'COMMON.CALC'
637 c double precision rrsave(maxdim)
643 eneps_temp(j,i)=0.0d0
648 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
649 c if (icall.eq.0) then
657 if (itypi.eq.ntyp1) cycle
658 itypi1=iabs(itype(i+1))
662 dxi=dc_norm(1,nres+i)
663 dyi=dc_norm(2,nres+i)
664 dzi=dc_norm(3,nres+i)
665 dsci_inv=vbld_inv(i+nres)
667 C Calculate SC interaction energy.
670 do j=istart(i,iint),iend(i,iint)
673 if (itypj.eq.ntyp1) cycle
674 dscj_inv=vbld_inv(j+nres)
675 chi1=chi(itypi,itypj)
676 chi2=chi(itypj,itypi)
683 alf12=0.5D0*(alf1+alf2)
684 C For diagnostics only!!!
697 dxj=dc_norm(1,nres+j)
698 dyj=dc_norm(2,nres+j)
699 dzj=dc_norm(3,nres+j)
700 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
701 cd if (icall.eq.0) then
707 C Calculate the angle-dependent terms of energy & contributions to derivatives.
709 C Calculate whole angle-dependent part of epsilon and contributions
711 fac=(rrij*sigsq)**expon2
712 e1=fac*fac*aa(itypi,itypj)
713 e2=fac*bb(itypi,itypj)
714 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
715 eps2der=evdwij*eps3rt
716 eps3der=evdwij*eps2rt
717 evdwij=evdwij*eps2rt*eps3rt
718 ij=icant(itypi,itypj)
719 aux=eps1*eps2rt**2*eps3rt**2
720 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
721 & /dabs(eps(itypi,itypj))
722 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
723 if (bb(itypi,itypj).gt.0.0d0) then
730 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
731 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
732 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
733 & restyp(itypi),i,restyp(itypj),j,
734 & epsi,sigm,chi1,chi2,chip1,chip2,
735 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
736 & om1,om2,om12,1.0D0/dsqrt(rrij),
739 C Calculate gradient components.
740 e1=e1*eps1*eps2rt**2*eps3rt**2
741 fac=-expon*(e1+evdwij)
744 C Calculate radial part of the gradient
748 C Calculate the angular part of the gradient and sum add the contributions
749 C to the appropriate components of the Cartesian gradient.
758 C-----------------------------------------------------------------------------
759 subroutine egb(evdw,evdw_t)
761 C This subroutine calculates the interaction energy of nonbonded side chains
762 C assuming the Gay-Berne potential of interaction.
764 implicit real*8 (a-h,o-z)
766 include 'DIMENSIONS.ZSCOPT'
767 include "DIMENSIONS.COMPAR"
770 include 'COMMON.LOCAL'
771 include 'COMMON.CHAIN'
772 include 'COMMON.DERIV'
773 include 'COMMON.NAMES'
774 include 'COMMON.INTERACT'
775 include 'COMMON.ENEPS'
776 include 'COMMON.IOUNITS'
777 include 'COMMON.CALC'
784 eneps_temp(j,i)=0.0d0
787 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
791 c if (icall.gt.0) lprn=.true.
795 if (itypi.eq.ntyp1) cycle
796 itypi1=iabs(itype(i+1))
800 C returning the ith atom to box
802 if (xi.lt.0) xi=xi+boxxsize
804 if (yi.lt.0) yi=yi+boxysize
806 if (zi.lt.0) zi=zi+boxzsize
808 dxi=dc_norm(1,nres+i)
809 dyi=dc_norm(2,nres+i)
810 dzi=dc_norm(3,nres+i)
811 dsci_inv=vbld_inv(i+nres)
813 C Calculate SC interaction energy.
816 do j=istart(i,iint),iend(i,iint)
819 if (itypj.eq.ntyp1) cycle
820 dscj_inv=vbld_inv(j+nres)
821 sig0ij=sigma(itypi,itypj)
822 chi1=chi(itypi,itypj)
823 chi2=chi(itypj,itypi)
830 alf12=0.5D0*(alf1+alf2)
831 C For diagnostics only!!!
844 C returning jth atom to box
846 if (xj.lt.0) xj=xj+boxxsize
848 if (yj.lt.0) yj=yj+boxysize
850 if (zj.lt.0) zj=zj+boxzsize
851 C checking the distance
852 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
857 C finding the closest
861 xj=xj_safe+xshift*boxxsize
862 yj=yj_safe+yshift*boxysize
863 zj=zj_safe+zshift*boxzsize
864 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
865 if(dist_temp.lt.dist_init) then
875 if (subchap.eq.1) then
885 dxj=dc_norm(1,nres+j)
886 dyj=dc_norm(2,nres+j)
887 dzj=dc_norm(3,nres+j)
888 c write (iout,*) i,j,xj,yj,zj
889 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
891 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
892 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
893 if (sss.le.0.0) cycle
894 C Calculate angle-dependent terms of energy and contributions to their
898 sig=sig0ij*dsqrt(sigsq)
899 rij_shift=1.0D0/rij-sig+sig0ij
900 C I hate to put IF's in the loops, but here don't have another choice!!!!
901 if (rij_shift.le.0.0D0) then
906 c---------------------------------------------------------------
907 rij_shift=1.0D0/rij_shift
909 e1=fac*fac*aa(itypi,itypj)
910 e2=fac*bb(itypi,itypj)
911 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
912 eps2der=evdwij*eps3rt
913 eps3der=evdwij*eps2rt
914 evdwij=evdwij*eps2rt*eps3rt
915 if (bb(itypi,itypj).gt.0) then
918 evdw_t=evdw_t+evdwij*sss
920 ij=icant(itypi,itypj)
921 aux=eps1*eps2rt**2*eps3rt**2
922 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
923 & /dabs(eps(itypi,itypj))
924 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
925 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
926 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
927 c & aux*e2/eps(itypi,itypj)
929 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
930 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
932 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
933 & restyp(itypi),i,restyp(itypj),j,
934 & epsi,sigm,chi1,chi2,chip1,chip2,
935 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
936 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
938 write (iout,*) "partial sum", evdw, evdw_t
942 C Calculate gradient components.
943 e1=e1*eps1*eps2rt**2*eps3rt**2
944 fac=-expon*(e1+evdwij)*rij_shift
947 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
948 C Calculate the radial part of the gradient
952 C Calculate angular part of the gradient.
960 C-----------------------------------------------------------------------------
961 subroutine egbv(evdw,evdw_t)
963 C This subroutine calculates the interaction energy of nonbonded side chains
964 C assuming the Gay-Berne-Vorobjev potential of interaction.
966 implicit real*8 (a-h,o-z)
968 include 'DIMENSIONS.ZSCOPT'
969 include "DIMENSIONS.COMPAR"
972 include 'COMMON.LOCAL'
973 include 'COMMON.CHAIN'
974 include 'COMMON.DERIV'
975 include 'COMMON.NAMES'
976 include 'COMMON.INTERACT'
977 include 'COMMON.ENEPS'
978 include 'COMMON.IOUNITS'
979 include 'COMMON.CALC'
986 eneps_temp(j,i)=0.0d0
991 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
994 c if (icall.gt.0) lprn=.true.
998 if (itypi.eq.ntyp1) cycle
999 itypi1=iabs(itype(i+1))
1003 dxi=dc_norm(1,nres+i)
1004 dyi=dc_norm(2,nres+i)
1005 dzi=dc_norm(3,nres+i)
1006 dsci_inv=vbld_inv(i+nres)
1008 C Calculate SC interaction energy.
1010 do iint=1,nint_gr(i)
1011 do j=istart(i,iint),iend(i,iint)
1013 itypj=iabs(itype(j))
1014 if (itypj.eq.ntyp1) cycle
1015 dscj_inv=vbld_inv(j+nres)
1016 sig0ij=sigma(itypi,itypj)
1017 r0ij=r0(itypi,itypj)
1018 chi1=chi(itypi,itypj)
1019 chi2=chi(itypj,itypi)
1026 alf12=0.5D0*(alf1+alf2)
1027 C For diagnostics only!!!
1040 dxj=dc_norm(1,nres+j)
1041 dyj=dc_norm(2,nres+j)
1042 dzj=dc_norm(3,nres+j)
1043 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1045 C Calculate angle-dependent terms of energy and contributions to their
1049 sig=sig0ij*dsqrt(sigsq)
1050 rij_shift=1.0D0/rij-sig+r0ij
1051 C I hate to put IF's in the loops, but here don't have another choice!!!!
1052 if (rij_shift.le.0.0D0) then
1057 c---------------------------------------------------------------
1058 rij_shift=1.0D0/rij_shift
1059 fac=rij_shift**expon
1060 e1=fac*fac*aa(itypi,itypj)
1061 e2=fac*bb(itypi,itypj)
1062 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1063 eps2der=evdwij*eps3rt
1064 eps3der=evdwij*eps2rt
1065 fac_augm=rrij**expon
1066 e_augm=augm(itypi,itypj)*fac_augm
1067 evdwij=evdwij*eps2rt*eps3rt
1068 if (bb(itypi,itypj).gt.0.0d0) then
1069 evdw=evdw+evdwij+e_augm
1071 evdw_t=evdw_t+evdwij+e_augm
1073 ij=icant(itypi,itypj)
1074 aux=eps1*eps2rt**2*eps3rt**2
1075 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1076 & /dabs(eps(itypi,itypj))
1077 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1078 c eneps_temp(ij)=eneps_temp(ij)
1079 c & +(evdwij+e_augm)/eps(itypi,itypj)
1081 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1082 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1083 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1084 c & restyp(itypi),i,restyp(itypj),j,
1085 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1086 c & chi1,chi2,chip1,chip2,
1087 c & eps1,eps2rt**2,eps3rt**2,
1088 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1092 C Calculate gradient components.
1093 e1=e1*eps1*eps2rt**2*eps3rt**2
1094 fac=-expon*(e1+evdwij)*rij_shift
1096 fac=rij*fac-2*expon*rrij*e_augm
1097 C Calculate the radial part of the gradient
1101 C Calculate angular part of the gradient.
1109 C-----------------------------------------------------------------------------
1110 subroutine sc_angular
1111 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1112 C om12. Called by ebp, egb, and egbv.
1114 include 'COMMON.CALC'
1118 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1119 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1120 om12=dxi*dxj+dyi*dyj+dzi*dzj
1122 C Calculate eps1(om12) and its derivative in om12
1123 faceps1=1.0D0-om12*chiom12
1124 faceps1_inv=1.0D0/faceps1
1125 eps1=dsqrt(faceps1_inv)
1126 C Following variable is eps1*deps1/dom12
1127 eps1_om12=faceps1_inv*chiom12
1128 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1133 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1134 sigsq=1.0D0-facsig*faceps1_inv
1135 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1136 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1137 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1138 C Calculate eps2 and its derivatives in om1, om2, and om12.
1141 chipom12=chip12*om12
1142 facp=1.0D0-om12*chipom12
1144 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1145 C Following variable is the square root of eps2
1146 eps2rt=1.0D0-facp1*facp_inv
1147 C Following three variables are the derivatives of the square root of eps
1148 C in om1, om2, and om12.
1149 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1150 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1151 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1152 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1153 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1154 C Calculate whole angle-dependent part of epsilon and contributions
1155 C to its derivatives
1158 C----------------------------------------------------------------------------
1160 implicit real*8 (a-h,o-z)
1161 include 'DIMENSIONS'
1162 include 'DIMENSIONS.ZSCOPT'
1163 include 'COMMON.CHAIN'
1164 include 'COMMON.DERIV'
1165 include 'COMMON.CALC'
1166 double precision dcosom1(3),dcosom2(3)
1167 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1168 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1169 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1170 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1172 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1173 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1176 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1179 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1180 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1181 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1182 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1183 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1184 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1187 C Calculate the components of the gradient in DC and X
1191 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1196 c------------------------------------------------------------------------------
1197 subroutine vec_and_deriv
1198 implicit real*8 (a-h,o-z)
1199 include 'DIMENSIONS'
1200 include 'DIMENSIONS.ZSCOPT'
1201 include 'COMMON.IOUNITS'
1202 include 'COMMON.GEO'
1203 include 'COMMON.VAR'
1204 include 'COMMON.LOCAL'
1205 include 'COMMON.CHAIN'
1206 include 'COMMON.VECTORS'
1207 include 'COMMON.DERIV'
1208 include 'COMMON.INTERACT'
1209 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1210 C Compute the local reference systems. For reference system (i), the
1211 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1212 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1214 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1215 if (i.eq.nres-1) then
1216 C Case of the last full residue
1217 C Compute the Z-axis
1218 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1219 costh=dcos(pi-theta(nres))
1220 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1225 C Compute the derivatives of uz
1227 uzder(2,1,1)=-dc_norm(3,i-1)
1228 uzder(3,1,1)= dc_norm(2,i-1)
1229 uzder(1,2,1)= dc_norm(3,i-1)
1231 uzder(3,2,1)=-dc_norm(1,i-1)
1232 uzder(1,3,1)=-dc_norm(2,i-1)
1233 uzder(2,3,1)= dc_norm(1,i-1)
1236 uzder(2,1,2)= dc_norm(3,i)
1237 uzder(3,1,2)=-dc_norm(2,i)
1238 uzder(1,2,2)=-dc_norm(3,i)
1240 uzder(3,2,2)= dc_norm(1,i)
1241 uzder(1,3,2)= dc_norm(2,i)
1242 uzder(2,3,2)=-dc_norm(1,i)
1245 C Compute the Y-axis
1248 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1251 C Compute the derivatives of uy
1254 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1255 & -dc_norm(k,i)*dc_norm(j,i-1)
1256 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1258 uyder(j,j,1)=uyder(j,j,1)-costh
1259 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1264 uygrad(l,k,j,i)=uyder(l,k,j)
1265 uzgrad(l,k,j,i)=uzder(l,k,j)
1269 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1270 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1271 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1272 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1276 C Compute the Z-axis
1277 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1278 costh=dcos(pi-theta(i+2))
1279 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1284 C Compute the derivatives of uz
1286 uzder(2,1,1)=-dc_norm(3,i+1)
1287 uzder(3,1,1)= dc_norm(2,i+1)
1288 uzder(1,2,1)= dc_norm(3,i+1)
1290 uzder(3,2,1)=-dc_norm(1,i+1)
1291 uzder(1,3,1)=-dc_norm(2,i+1)
1292 uzder(2,3,1)= dc_norm(1,i+1)
1295 uzder(2,1,2)= dc_norm(3,i)
1296 uzder(3,1,2)=-dc_norm(2,i)
1297 uzder(1,2,2)=-dc_norm(3,i)
1299 uzder(3,2,2)= dc_norm(1,i)
1300 uzder(1,3,2)= dc_norm(2,i)
1301 uzder(2,3,2)=-dc_norm(1,i)
1304 C Compute the Y-axis
1307 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1310 C Compute the derivatives of uy
1313 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1314 & -dc_norm(k,i)*dc_norm(j,i+1)
1315 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1317 uyder(j,j,1)=uyder(j,j,1)-costh
1318 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1323 uygrad(l,k,j,i)=uyder(l,k,j)
1324 uzgrad(l,k,j,i)=uzder(l,k,j)
1328 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1329 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1330 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1331 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1337 vbld_inv_temp(1)=vbld_inv(i+1)
1338 if (i.lt.nres-1) then
1339 vbld_inv_temp(2)=vbld_inv(i+2)
1341 vbld_inv_temp(2)=vbld_inv(i)
1346 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1347 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1355 C-----------------------------------------------------------------------------
1356 subroutine vec_and_deriv_test
1357 implicit real*8 (a-h,o-z)
1358 include 'DIMENSIONS'
1359 include 'DIMENSIONS.ZSCOPT'
1360 include 'COMMON.IOUNITS'
1361 include 'COMMON.GEO'
1362 include 'COMMON.VAR'
1363 include 'COMMON.LOCAL'
1364 include 'COMMON.CHAIN'
1365 include 'COMMON.VECTORS'
1366 dimension uyder(3,3,2),uzder(3,3,2)
1367 C Compute the local reference systems. For reference system (i), the
1368 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1369 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1371 if (i.eq.nres-1) then
1372 C Case of the last full residue
1373 C Compute the Z-axis
1374 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1375 costh=dcos(pi-theta(nres))
1376 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1377 c write (iout,*) 'fac',fac,
1378 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1379 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1383 C Compute the derivatives of uz
1385 uzder(2,1,1)=-dc_norm(3,i-1)
1386 uzder(3,1,1)= dc_norm(2,i-1)
1387 uzder(1,2,1)= dc_norm(3,i-1)
1389 uzder(3,2,1)=-dc_norm(1,i-1)
1390 uzder(1,3,1)=-dc_norm(2,i-1)
1391 uzder(2,3,1)= dc_norm(1,i-1)
1394 uzder(2,1,2)= dc_norm(3,i)
1395 uzder(3,1,2)=-dc_norm(2,i)
1396 uzder(1,2,2)=-dc_norm(3,i)
1398 uzder(3,2,2)= dc_norm(1,i)
1399 uzder(1,3,2)= dc_norm(2,i)
1400 uzder(2,3,2)=-dc_norm(1,i)
1402 C Compute the Y-axis
1404 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1407 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1408 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1409 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1411 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1414 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1415 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1418 c write (iout,*) 'facy',facy,
1419 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1420 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1422 uy(k,i)=facy*uy(k,i)
1424 C Compute the derivatives of uy
1427 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1428 & -dc_norm(k,i)*dc_norm(j,i-1)
1429 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1431 c uyder(j,j,1)=uyder(j,j,1)-costh
1432 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1433 uyder(j,j,1)=uyder(j,j,1)
1434 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1435 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1441 uygrad(l,k,j,i)=uyder(l,k,j)
1442 uzgrad(l,k,j,i)=uzder(l,k,j)
1446 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1447 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1448 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1449 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1452 C Compute the Z-axis
1453 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1454 costh=dcos(pi-theta(i+2))
1455 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1456 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1460 C Compute the derivatives of uz
1462 uzder(2,1,1)=-dc_norm(3,i+1)
1463 uzder(3,1,1)= dc_norm(2,i+1)
1464 uzder(1,2,1)= dc_norm(3,i+1)
1466 uzder(3,2,1)=-dc_norm(1,i+1)
1467 uzder(1,3,1)=-dc_norm(2,i+1)
1468 uzder(2,3,1)= dc_norm(1,i+1)
1471 uzder(2,1,2)= dc_norm(3,i)
1472 uzder(3,1,2)=-dc_norm(2,i)
1473 uzder(1,2,2)=-dc_norm(3,i)
1475 uzder(3,2,2)= dc_norm(1,i)
1476 uzder(1,3,2)= dc_norm(2,i)
1477 uzder(2,3,2)=-dc_norm(1,i)
1479 C Compute the Y-axis
1481 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1482 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1483 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1485 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1488 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1489 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1492 c write (iout,*) 'facy',facy,
1493 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1494 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1496 uy(k,i)=facy*uy(k,i)
1498 C Compute the derivatives of uy
1501 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1502 & -dc_norm(k,i)*dc_norm(j,i+1)
1503 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1505 c uyder(j,j,1)=uyder(j,j,1)-costh
1506 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1507 uyder(j,j,1)=uyder(j,j,1)
1508 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1509 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1515 uygrad(l,k,j,i)=uyder(l,k,j)
1516 uzgrad(l,k,j,i)=uzder(l,k,j)
1520 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1521 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1522 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1523 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1530 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1531 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1538 C-----------------------------------------------------------------------------
1539 subroutine check_vecgrad
1540 implicit real*8 (a-h,o-z)
1541 include 'DIMENSIONS'
1542 include 'DIMENSIONS.ZSCOPT'
1543 include 'COMMON.IOUNITS'
1544 include 'COMMON.GEO'
1545 include 'COMMON.VAR'
1546 include 'COMMON.LOCAL'
1547 include 'COMMON.CHAIN'
1548 include 'COMMON.VECTORS'
1549 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1550 dimension uyt(3,maxres),uzt(3,maxres)
1551 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1552 double precision delta /1.0d-7/
1555 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1556 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1557 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1558 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1559 cd & (dc_norm(if90,i),if90=1,3)
1560 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1561 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1562 cd write(iout,'(a)')
1568 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1569 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1582 cd write (iout,*) 'i=',i
1584 erij(k)=dc_norm(k,i)
1588 dc_norm(k,i)=erij(k)
1590 dc_norm(j,i)=dc_norm(j,i)+delta
1591 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1593 c dc_norm(k,i)=dc_norm(k,i)/fac
1595 c write (iout,*) (dc_norm(k,i),k=1,3)
1596 c write (iout,*) (erij(k),k=1,3)
1599 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1600 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1601 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1602 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1604 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1605 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1606 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1609 dc_norm(k,i)=erij(k)
1612 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1613 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1614 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1615 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1616 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1617 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1618 cd write (iout,'(a)')
1623 C--------------------------------------------------------------------------
1624 subroutine set_matrices
1625 implicit real*8 (a-h,o-z)
1626 include 'DIMENSIONS'
1627 include 'DIMENSIONS.ZSCOPT'
1628 include 'COMMON.IOUNITS'
1629 include 'COMMON.GEO'
1630 include 'COMMON.VAR'
1631 include 'COMMON.LOCAL'
1632 include 'COMMON.CHAIN'
1633 include 'COMMON.DERIV'
1634 include 'COMMON.INTERACT'
1635 include 'COMMON.CONTACTS'
1636 include 'COMMON.TORSION'
1637 include 'COMMON.VECTORS'
1638 include 'COMMON.FFIELD'
1639 double precision auxvec(2),auxmat(2,2)
1641 C Compute the virtual-bond-torsional-angle dependent quantities needed
1642 C to calculate the el-loc multibody terms of various order.
1645 if (i .lt. nres+1) then
1682 if (i .gt. 3 .and. i .lt. nres+1) then
1683 obrot_der(1,i-2)=-sin1
1684 obrot_der(2,i-2)= cos1
1685 Ugder(1,1,i-2)= sin1
1686 Ugder(1,2,i-2)=-cos1
1687 Ugder(2,1,i-2)=-cos1
1688 Ugder(2,2,i-2)=-sin1
1691 obrot2_der(1,i-2)=-dwasin2
1692 obrot2_der(2,i-2)= dwacos2
1693 Ug2der(1,1,i-2)= dwasin2
1694 Ug2der(1,2,i-2)=-dwacos2
1695 Ug2der(2,1,i-2)=-dwacos2
1696 Ug2der(2,2,i-2)=-dwasin2
1698 obrot_der(1,i-2)=0.0d0
1699 obrot_der(2,i-2)=0.0d0
1700 Ugder(1,1,i-2)=0.0d0
1701 Ugder(1,2,i-2)=0.0d0
1702 Ugder(2,1,i-2)=0.0d0
1703 Ugder(2,2,i-2)=0.0d0
1704 obrot2_der(1,i-2)=0.0d0
1705 obrot2_der(2,i-2)=0.0d0
1706 Ug2der(1,1,i-2)=0.0d0
1707 Ug2der(1,2,i-2)=0.0d0
1708 Ug2der(2,1,i-2)=0.0d0
1709 Ug2der(2,2,i-2)=0.0d0
1711 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1712 if (itype(i-2).le.ntyp) then
1713 iti = itortyp(itype(i-2))
1720 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1721 if (itype(i-1).le.ntyp) then
1722 iti1 = itortyp(itype(i-1))
1729 cd write (iout,*) '*******i',i,' iti1',iti
1730 cd write (iout,*) 'b1',b1(:,iti)
1731 cd write (iout,*) 'b2',b2(:,iti)
1732 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1733 c print *,"itilde1 i iti iti1",i,iti,iti1
1734 if (i .gt. iatel_s+2) then
1735 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1736 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1737 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1738 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1739 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1740 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1741 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1751 DtUg2(l,k,i-2)=0.0d0
1755 c print *,"itilde2 i iti iti1",i,iti,iti1
1756 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1757 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1758 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1759 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1760 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1761 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1762 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1763 c print *,"itilde3 i iti iti1",i,iti,iti1
1765 muder(k,i-2)=Ub2der(k,i-2)
1767 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1768 if (itype(i-1).le.ntyp) then
1769 iti1 = itortyp(itype(i-1))
1777 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1779 C Vectors and matrices dependent on a single virtual-bond dihedral.
1780 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1781 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1782 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1783 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1784 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1785 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1786 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1787 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1788 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1789 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1790 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1792 C Matrices dependent on two consecutive virtual-bond dihedrals.
1793 C The order of matrices is from left to right.
1795 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1796 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1797 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1798 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1799 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1800 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1801 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1802 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1805 cd iti = itortyp(itype(i))
1808 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1809 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1814 C--------------------------------------------------------------------------
1815 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1817 C This subroutine calculates the average interaction energy and its gradient
1818 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1819 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1820 C The potential depends both on the distance of peptide-group centers and on
1821 C the orientation of the CA-CA virtual bonds.
1823 implicit real*8 (a-h,o-z)
1824 include 'DIMENSIONS'
1825 include 'DIMENSIONS.ZSCOPT'
1826 include 'COMMON.CONTROL'
1827 include 'COMMON.IOUNITS'
1828 include 'COMMON.GEO'
1829 include 'COMMON.VAR'
1830 include 'COMMON.LOCAL'
1831 include 'COMMON.CHAIN'
1832 include 'COMMON.DERIV'
1833 include 'COMMON.INTERACT'
1834 include 'COMMON.CONTACTS'
1835 include 'COMMON.TORSION'
1836 include 'COMMON.VECTORS'
1837 include 'COMMON.FFIELD'
1838 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1839 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1840 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1841 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1842 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1843 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1844 double precision scal_el /0.5d0/
1846 C 13-go grudnia roku pamietnego...
1847 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1848 & 0.0d0,1.0d0,0.0d0,
1849 & 0.0d0,0.0d0,1.0d0/
1850 cd write(iout,*) 'In EELEC'
1852 cd write(iout,*) 'Type',i
1853 cd write(iout,*) 'B1',B1(:,i)
1854 cd write(iout,*) 'B2',B2(:,i)
1855 cd write(iout,*) 'CC',CC(:,:,i)
1856 cd write(iout,*) 'DD',DD(:,:,i)
1857 cd write(iout,*) 'EE',EE(:,:,i)
1859 cd call check_vecgrad
1861 if (icheckgrad.eq.1) then
1863 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1865 dc_norm(k,i)=dc(k,i)*fac
1867 c write (iout,*) 'i',i,' fac',fac
1870 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1871 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1872 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1873 cd if (wel_loc.gt.0.0d0) then
1874 if (icheckgrad.eq.1) then
1875 call vec_and_deriv_test
1882 cd write (iout,*) 'i=',i
1884 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1887 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1888 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1901 cd print '(a)','Enter EELEC'
1902 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1904 gel_loc_loc(i)=0.0d0
1907 do i=iatel_s,iatel_e
1908 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
1909 & .or. itype(i+2).eq.ntyp1
1910 & .or. itype(i-1).eq.ntyp1
1912 if (itel(i).eq.0) goto 1215
1916 dx_normi=dc_norm(1,i)
1917 dy_normi=dc_norm(2,i)
1918 dz_normi=dc_norm(3,i)
1919 xmedi=c(1,i)+0.5d0*dxi
1920 ymedi=c(2,i)+0.5d0*dyi
1921 zmedi=c(3,i)+0.5d0*dzi
1922 xmedi=mod(xmedi,boxxsize)
1923 if (xmedi.lt.0) xmedi=xmedi+boxxsize
1924 ymedi=mod(ymedi,boxysize)
1925 if (ymedi.lt.0) ymedi=ymedi+boxysize
1926 zmedi=mod(zmedi,boxzsize)
1927 if (zmedi.lt.0) zmedi=zmedi+boxzsize
1929 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1930 do j=ielstart(i),ielend(i)
1931 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
1932 & .or.itype(j+2).eq.ntyp1
1933 & .or.itype(j-1).eq.ntyp1
1937 if (itel(j).eq.0) goto 1216
1941 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1942 aaa=app(iteli,itelj)
1943 bbb=bpp(iteli,itelj)
1944 C Diagnostics only!!!
1950 ael6i=ael6(iteli,itelj)
1951 ael3i=ael3(iteli,itelj)
1955 dx_normj=dc_norm(1,j)
1956 dy_normj=dc_norm(2,j)
1957 dz_normj=dc_norm(3,j)
1962 if (xj.lt.0) xj=xj+boxxsize
1964 if (yj.lt.0) yj=yj+boxysize
1966 if (zj.lt.0) zj=zj+boxzsize
1967 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1975 xj=xj_safe+xshift*boxxsize
1976 yj=yj_safe+yshift*boxysize
1977 zj=zj_safe+zshift*boxzsize
1978 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1979 if(dist_temp.lt.dist_init) then
1989 if (isubchap.eq.1) then
1999 rij=xj*xj+yj*yj+zj*zj
2000 sss=sscale(sqrt(rij))
2001 sssgrad=sscagrad(sqrt(rij))
2007 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2008 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2009 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2010 fac=cosa-3.0D0*cosb*cosg
2012 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2013 if (j.eq.i+2) ev1=scal_el*ev1
2018 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2021 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2022 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2023 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2025 evdw1=evdw1+evdwij*sss
2026 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2027 c &'evdw1',i,j,evdwij
2028 c &,iteli,itelj,aaa,evdw1
2030 c write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2031 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2032 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2033 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2034 c & xmedi,ymedi,zmedi,xj,yj,zj
2036 C Calculate contributions to the Cartesian gradient.
2039 facvdw=-6*rrmij*(ev1+evdwij)*sss
2040 facel=-3*rrmij*(el1+eesij)
2047 * Radial derivatives. First process both termini of the fragment (i,j)
2054 gelc(k,i)=gelc(k,i)+ghalf
2055 gelc(k,j)=gelc(k,j)+ghalf
2058 * Loop over residues i+1 thru j-1.
2062 gelc(l,k)=gelc(l,k)+ggg(l)
2068 if (sss.gt.0.0) then
2069 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2070 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2071 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2079 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2080 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2083 * Loop over residues i+1 thru j-1.
2087 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2091 facvdw=(ev1+evdwij)*sss
2094 fac=-3*rrmij*(facvdw+facvdw+facel)
2100 * Radial derivatives. First process both termini of the fragment (i,j)
2107 gelc(k,i)=gelc(k,i)+ghalf
2108 gelc(k,j)=gelc(k,j)+ghalf
2111 * Loop over residues i+1 thru j-1.
2115 gelc(l,k)=gelc(l,k)+ggg(l)
2122 ecosa=2.0D0*fac3*fac1+fac4
2125 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2126 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2128 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2129 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2131 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2132 cd & (dcosg(k),k=1,3)
2134 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2138 gelc(k,i)=gelc(k,i)+ghalf
2139 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2140 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2141 gelc(k,j)=gelc(k,j)+ghalf
2142 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2143 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2147 gelc(l,k)=gelc(l,k)+ggg(l)
2152 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2153 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2154 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2156 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2157 C energy of a peptide unit is assumed in the form of a second-order
2158 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2159 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2160 C are computed for EVERY pair of non-contiguous peptide groups.
2162 if (j.lt.nres-1) then
2173 muij(kkk)=mu(k,i)*mu(l,j)
2176 cd write (iout,*) 'EELEC: i',i,' j',j
2177 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2178 cd write(iout,*) 'muij',muij
2179 ury=scalar(uy(1,i),erij)
2180 urz=scalar(uz(1,i),erij)
2181 vry=scalar(uy(1,j),erij)
2182 vrz=scalar(uz(1,j),erij)
2183 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2184 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2185 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2186 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2187 C For diagnostics only
2192 fac=dsqrt(-ael6i)*r3ij
2193 cd write (2,*) 'fac=',fac
2194 C For diagnostics only
2200 cd write (iout,'(4i5,4f10.5)')
2201 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2202 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2203 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2204 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2205 cd write (iout,'(4f10.5)')
2206 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2207 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2208 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2209 cd write (iout,'(2i3,9f10.5/)') i,j,
2210 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2212 C Derivatives of the elements of A in virtual-bond vectors
2213 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2220 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2221 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2222 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2223 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2224 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2225 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2226 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2227 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2228 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2229 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2230 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2231 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2241 C Compute radial contributions to the gradient
2263 C Add the contributions coming from er
2266 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2267 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2268 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2269 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2272 C Derivatives in DC(i)
2273 ghalf1=0.5d0*agg(k,1)
2274 ghalf2=0.5d0*agg(k,2)
2275 ghalf3=0.5d0*agg(k,3)
2276 ghalf4=0.5d0*agg(k,4)
2277 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2278 & -3.0d0*uryg(k,2)*vry)+ghalf1
2279 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2280 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2281 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2282 & -3.0d0*urzg(k,2)*vry)+ghalf3
2283 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2284 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2285 C Derivatives in DC(i+1)
2286 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2287 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2288 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2289 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2290 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2291 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2292 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2293 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2294 C Derivatives in DC(j)
2295 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2296 & -3.0d0*vryg(k,2)*ury)+ghalf1
2297 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2298 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2299 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2300 & -3.0d0*vryg(k,2)*urz)+ghalf3
2301 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2302 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2303 C Derivatives in DC(j+1) or DC(nres-1)
2304 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2305 & -3.0d0*vryg(k,3)*ury)
2306 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2307 & -3.0d0*vrzg(k,3)*ury)
2308 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2309 & -3.0d0*vryg(k,3)*urz)
2310 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2311 & -3.0d0*vrzg(k,3)*urz)
2316 C Derivatives in DC(i+1)
2317 cd aggi1(k,1)=agg(k,1)
2318 cd aggi1(k,2)=agg(k,2)
2319 cd aggi1(k,3)=agg(k,3)
2320 cd aggi1(k,4)=agg(k,4)
2321 C Derivatives in DC(j)
2326 C Derivatives in DC(j+1)
2331 if (j.eq.nres-1 .and. i.lt.j-2) then
2333 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2334 cd aggj1(k,l)=agg(k,l)
2340 C Check the loc-el terms by numerical integration
2350 aggi(k,l)=-aggi(k,l)
2351 aggi1(k,l)=-aggi1(k,l)
2352 aggj(k,l)=-aggj(k,l)
2353 aggj1(k,l)=-aggj1(k,l)
2356 if (j.lt.nres-1) then
2362 aggi(k,l)=-aggi(k,l)
2363 aggi1(k,l)=-aggi1(k,l)
2364 aggj(k,l)=-aggj(k,l)
2365 aggj1(k,l)=-aggj1(k,l)
2376 aggi(k,l)=-aggi(k,l)
2377 aggi1(k,l)=-aggi1(k,l)
2378 aggj(k,l)=-aggj(k,l)
2379 aggj1(k,l)=-aggj1(k,l)
2385 IF (wel_loc.gt.0.0d0) THEN
2386 C Contribution to the local-electrostatic energy coming from the i-j pair
2387 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2389 c write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2390 c write (iout,'(a6,2i5,0pf7.3)')
2391 c & 'eelloc',i,j,eel_loc_ij
2392 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2393 eel_loc=eel_loc+eel_loc_ij
2394 C Partial derivatives in virtual-bond dihedral angles gamma
2397 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2398 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2399 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2400 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2401 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2402 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2403 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2404 cd write(iout,*) 'agg ',agg
2405 cd write(iout,*) 'aggi ',aggi
2406 cd write(iout,*) 'aggi1',aggi1
2407 cd write(iout,*) 'aggj ',aggj
2408 cd write(iout,*) 'aggj1',aggj1
2410 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2412 ggg(l)=agg(l,1)*muij(1)+
2413 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2417 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2420 C Remaining derivatives of eello
2422 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2423 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2424 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2425 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2426 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2427 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2428 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2429 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2433 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2434 C Contributions from turns
2439 call eturn34(i,j,eello_turn3,eello_turn4)
2441 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2442 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2444 C Calculate the contact function. The ith column of the array JCONT will
2445 C contain the numbers of atoms that make contacts with the atom I (of numbers
2446 C greater than I). The arrays FACONT and GACONT will contain the values of
2447 C the contact function and its derivative.
2448 c r0ij=1.02D0*rpp(iteli,itelj)
2449 c r0ij=1.11D0*rpp(iteli,itelj)
2450 r0ij=2.20D0*rpp(iteli,itelj)
2451 c r0ij=1.55D0*rpp(iteli,itelj)
2452 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2453 if (fcont.gt.0.0D0) then
2454 num_conti=num_conti+1
2455 if (num_conti.gt.maxconts) then
2456 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2457 & ' will skip next contacts for this conf.'
2459 jcont_hb(num_conti,i)=j
2460 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2461 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2462 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2464 d_cont(num_conti,i)=rij
2465 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2466 C --- Electrostatic-interaction matrix ---
2467 a_chuj(1,1,num_conti,i)=a22
2468 a_chuj(1,2,num_conti,i)=a23
2469 a_chuj(2,1,num_conti,i)=a32
2470 a_chuj(2,2,num_conti,i)=a33
2471 C --- Gradient of rij
2473 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2476 c a_chuj(1,1,num_conti,i)=-0.61d0
2477 c a_chuj(1,2,num_conti,i)= 0.4d0
2478 c a_chuj(2,1,num_conti,i)= 0.65d0
2479 c a_chuj(2,2,num_conti,i)= 0.50d0
2480 c else if (i.eq.2) then
2481 c a_chuj(1,1,num_conti,i)= 0.0d0
2482 c a_chuj(1,2,num_conti,i)= 0.0d0
2483 c a_chuj(2,1,num_conti,i)= 0.0d0
2484 c a_chuj(2,2,num_conti,i)= 0.0d0
2486 C --- and its gradients
2487 cd write (iout,*) 'i',i,' j',j
2489 cd write (iout,*) 'iii 1 kkk',kkk
2490 cd write (iout,*) agg(kkk,:)
2493 cd write (iout,*) 'iii 2 kkk',kkk
2494 cd write (iout,*) aggi(kkk,:)
2497 cd write (iout,*) 'iii 3 kkk',kkk
2498 cd write (iout,*) aggi1(kkk,:)
2501 cd write (iout,*) 'iii 4 kkk',kkk
2502 cd write (iout,*) aggj(kkk,:)
2505 cd write (iout,*) 'iii 5 kkk',kkk
2506 cd write (iout,*) aggj1(kkk,:)
2513 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2514 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2515 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2516 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2517 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2519 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2525 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2526 C Calculate contact energies
2528 wij=cosa-3.0D0*cosb*cosg
2531 c fac3=dsqrt(-ael6i)/r0ij**3
2532 fac3=dsqrt(-ael6i)*r3ij
2533 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2534 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2536 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2537 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2538 C Diagnostics. Comment out or remove after debugging!
2539 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2540 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2541 c ees0m(num_conti,i)=0.0D0
2543 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2544 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2545 facont_hb(num_conti,i)=fcont
2547 C Angular derivatives of the contact function
2548 ees0pij1=fac3/ees0pij
2549 ees0mij1=fac3/ees0mij
2550 fac3p=-3.0D0*fac3*rrmij
2551 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2552 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2554 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2555 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2556 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2557 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2558 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2559 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2560 ecosap=ecosa1+ecosa2
2561 ecosbp=ecosb1+ecosb2
2562 ecosgp=ecosg1+ecosg2
2563 ecosam=ecosa1-ecosa2
2564 ecosbm=ecosb1-ecosb2
2565 ecosgm=ecosg1-ecosg2
2574 fprimcont=fprimcont/rij
2575 cd facont_hb(num_conti,i)=1.0D0
2576 C Following line is for diagnostics.
2579 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2580 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2583 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2584 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2586 gggp(1)=gggp(1)+ees0pijp*xj
2587 gggp(2)=gggp(2)+ees0pijp*yj
2588 gggp(3)=gggp(3)+ees0pijp*zj
2589 gggm(1)=gggm(1)+ees0mijp*xj
2590 gggm(2)=gggm(2)+ees0mijp*yj
2591 gggm(3)=gggm(3)+ees0mijp*zj
2592 C Derivatives due to the contact function
2593 gacont_hbr(1,num_conti,i)=fprimcont*xj
2594 gacont_hbr(2,num_conti,i)=fprimcont*yj
2595 gacont_hbr(3,num_conti,i)=fprimcont*zj
2597 ghalfp=0.5D0*gggp(k)
2598 ghalfm=0.5D0*gggm(k)
2599 gacontp_hb1(k,num_conti,i)=ghalfp
2600 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2601 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2602 gacontp_hb2(k,num_conti,i)=ghalfp
2603 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2604 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2605 gacontp_hb3(k,num_conti,i)=gggp(k)
2606 gacontm_hb1(k,num_conti,i)=ghalfm
2607 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2608 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2609 gacontm_hb2(k,num_conti,i)=ghalfm
2610 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2611 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2612 gacontm_hb3(k,num_conti,i)=gggm(k)
2615 C Diagnostics. Comment out or remove after debugging!
2617 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2618 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2619 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2620 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2621 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2622 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2625 endif ! num_conti.le.maxconts
2630 num_cont_hb(i)=num_conti
2634 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2635 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2637 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2638 ccc eel_loc=eel_loc+eello_turn3
2641 C-----------------------------------------------------------------------------
2642 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2643 C Third- and fourth-order contributions from turns
2644 implicit real*8 (a-h,o-z)
2645 include 'DIMENSIONS'
2646 include 'DIMENSIONS.ZSCOPT'
2647 include 'COMMON.IOUNITS'
2648 include 'COMMON.GEO'
2649 include 'COMMON.VAR'
2650 include 'COMMON.LOCAL'
2651 include 'COMMON.CHAIN'
2652 include 'COMMON.DERIV'
2653 include 'COMMON.INTERACT'
2654 include 'COMMON.CONTACTS'
2655 include 'COMMON.TORSION'
2656 include 'COMMON.VECTORS'
2657 include 'COMMON.FFIELD'
2659 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2660 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2661 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2662 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2663 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2664 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2666 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2668 C Third-order contributions
2675 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2676 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2677 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2678 call transpose2(auxmat(1,1),auxmat1(1,1))
2679 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2680 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2681 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2682 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2683 cd & ' eello_turn3_num',4*eello_turn3_num
2685 C Derivatives in gamma(i)
2686 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2687 call transpose2(auxmat2(1,1),pizda(1,1))
2688 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2689 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2690 C Derivatives in gamma(i+1)
2691 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2692 call transpose2(auxmat2(1,1),pizda(1,1))
2693 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2694 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2695 & +0.5d0*(pizda(1,1)+pizda(2,2))
2696 C Cartesian derivatives
2698 a_temp(1,1)=aggi(l,1)
2699 a_temp(1,2)=aggi(l,2)
2700 a_temp(2,1)=aggi(l,3)
2701 a_temp(2,2)=aggi(l,4)
2702 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2703 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2704 & +0.5d0*(pizda(1,1)+pizda(2,2))
2705 a_temp(1,1)=aggi1(l,1)
2706 a_temp(1,2)=aggi1(l,2)
2707 a_temp(2,1)=aggi1(l,3)
2708 a_temp(2,2)=aggi1(l,4)
2709 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2710 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2711 & +0.5d0*(pizda(1,1)+pizda(2,2))
2712 a_temp(1,1)=aggj(l,1)
2713 a_temp(1,2)=aggj(l,2)
2714 a_temp(2,1)=aggj(l,3)
2715 a_temp(2,2)=aggj(l,4)
2716 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2717 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2718 & +0.5d0*(pizda(1,1)+pizda(2,2))
2719 a_temp(1,1)=aggj1(l,1)
2720 a_temp(1,2)=aggj1(l,2)
2721 a_temp(2,1)=aggj1(l,3)
2722 a_temp(2,2)=aggj1(l,4)
2723 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2724 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2725 & +0.5d0*(pizda(1,1)+pizda(2,2))
2728 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
2729 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2731 C Fourth-order contributions
2739 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2740 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2741 iti1=itortyp(itype(i+1))
2742 iti2=itortyp(itype(i+2))
2743 iti3=itortyp(itype(i+3))
2744 call transpose2(EUg(1,1,i+1),e1t(1,1))
2745 call transpose2(Eug(1,1,i+2),e2t(1,1))
2746 call transpose2(Eug(1,1,i+3),e3t(1,1))
2747 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2748 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2749 s1=scalar2(b1(1,iti2),auxvec(1))
2750 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2751 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2752 s2=scalar2(b1(1,iti1),auxvec(1))
2753 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2754 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2755 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2756 eello_turn4=eello_turn4-(s1+s2+s3)
2757 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2758 cd & ' eello_turn4_num',8*eello_turn4_num
2759 C Derivatives in gamma(i)
2761 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2762 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2763 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2764 s1=scalar2(b1(1,iti2),auxvec(1))
2765 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2766 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2767 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2768 C Derivatives in gamma(i+1)
2769 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2770 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2771 s2=scalar2(b1(1,iti1),auxvec(1))
2772 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2773 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2774 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2775 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2776 C Derivatives in gamma(i+2)
2777 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2778 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2779 s1=scalar2(b1(1,iti2),auxvec(1))
2780 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2781 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2782 s2=scalar2(b1(1,iti1),auxvec(1))
2783 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2784 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2785 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2786 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2787 C Cartesian derivatives
2788 C Derivatives of this turn contributions in DC(i+2)
2789 if (j.lt.nres-1) then
2791 a_temp(1,1)=agg(l,1)
2792 a_temp(1,2)=agg(l,2)
2793 a_temp(2,1)=agg(l,3)
2794 a_temp(2,2)=agg(l,4)
2795 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2796 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2797 s1=scalar2(b1(1,iti2),auxvec(1))
2798 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2799 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2800 s2=scalar2(b1(1,iti1),auxvec(1))
2801 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2802 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2803 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2805 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2808 C Remaining derivatives of this turn contribution
2810 a_temp(1,1)=aggi(l,1)
2811 a_temp(1,2)=aggi(l,2)
2812 a_temp(2,1)=aggi(l,3)
2813 a_temp(2,2)=aggi(l,4)
2814 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2815 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2816 s1=scalar2(b1(1,iti2),auxvec(1))
2817 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2818 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2819 s2=scalar2(b1(1,iti1),auxvec(1))
2820 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2821 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2822 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2823 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2824 a_temp(1,1)=aggi1(l,1)
2825 a_temp(1,2)=aggi1(l,2)
2826 a_temp(2,1)=aggi1(l,3)
2827 a_temp(2,2)=aggi1(l,4)
2828 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2829 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2830 s1=scalar2(b1(1,iti2),auxvec(1))
2831 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2832 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2833 s2=scalar2(b1(1,iti1),auxvec(1))
2834 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2835 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2836 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2837 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2838 a_temp(1,1)=aggj(l,1)
2839 a_temp(1,2)=aggj(l,2)
2840 a_temp(2,1)=aggj(l,3)
2841 a_temp(2,2)=aggj(l,4)
2842 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2843 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2844 s1=scalar2(b1(1,iti2),auxvec(1))
2845 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2846 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2847 s2=scalar2(b1(1,iti1),auxvec(1))
2848 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2849 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2850 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2851 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2852 a_temp(1,1)=aggj1(l,1)
2853 a_temp(1,2)=aggj1(l,2)
2854 a_temp(2,1)=aggj1(l,3)
2855 a_temp(2,2)=aggj1(l,4)
2856 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2857 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2858 s1=scalar2(b1(1,iti2),auxvec(1))
2859 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2860 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2861 s2=scalar2(b1(1,iti1),auxvec(1))
2862 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2863 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2864 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2865 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2871 C-----------------------------------------------------------------------------
2872 subroutine vecpr(u,v,w)
2873 implicit real*8(a-h,o-z)
2874 dimension u(3),v(3),w(3)
2875 w(1)=u(2)*v(3)-u(3)*v(2)
2876 w(2)=-u(1)*v(3)+u(3)*v(1)
2877 w(3)=u(1)*v(2)-u(2)*v(1)
2880 C-----------------------------------------------------------------------------
2881 subroutine unormderiv(u,ugrad,unorm,ungrad)
2882 C This subroutine computes the derivatives of a normalized vector u, given
2883 C the derivatives computed without normalization conditions, ugrad. Returns
2886 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2887 double precision vec(3)
2888 double precision scalar
2890 c write (2,*) 'ugrad',ugrad
2893 vec(i)=scalar(ugrad(1,i),u(1))
2895 c write (2,*) 'vec',vec
2898 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2901 c write (2,*) 'ungrad',ungrad
2904 C-----------------------------------------------------------------------------
2905 subroutine escp(evdw2,evdw2_14)
2907 C This subroutine calculates the excluded-volume interaction energy between
2908 C peptide-group centers and side chains and its gradient in virtual-bond and
2909 C side-chain vectors.
2911 implicit real*8 (a-h,o-z)
2912 include 'DIMENSIONS'
2913 include 'DIMENSIONS.ZSCOPT'
2914 include 'COMMON.GEO'
2915 include 'COMMON.VAR'
2916 include 'COMMON.LOCAL'
2917 include 'COMMON.CHAIN'
2918 include 'COMMON.DERIV'
2919 include 'COMMON.INTERACT'
2920 include 'COMMON.FFIELD'
2921 include 'COMMON.IOUNITS'
2925 cd print '(a)','Enter ESCP'
2926 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2927 c & ' scal14',scal14
2928 do i=iatscp_s,iatscp_e
2929 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2931 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2932 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2933 if (iteli.eq.0) goto 1225
2934 xi=0.5D0*(c(1,i)+c(1,i+1))
2935 yi=0.5D0*(c(2,i)+c(2,i+1))
2936 zi=0.5D0*(c(3,i)+c(3,i+1))
2937 C Returning the ith atom to box
2939 if (xi.lt.0) xi=xi+boxxsize
2941 if (yi.lt.0) yi=yi+boxysize
2943 if (zi.lt.0) zi=zi+boxzsize
2944 do iint=1,nscp_gr(i)
2946 do j=iscpstart(i,iint),iscpend(i,iint)
2947 itypj=iabs(itype(j))
2948 if (itypj.eq.ntyp1) cycle
2949 C Uncomment following three lines for SC-p interactions
2953 C Uncomment following three lines for Ca-p interactions
2957 C returning the jth atom to box
2959 if (xj.lt.0) xj=xj+boxxsize
2961 if (yj.lt.0) yj=yj+boxysize
2963 if (zj.lt.0) zj=zj+boxzsize
2964 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2969 C Finding the closest jth atom
2973 xj=xj_safe+xshift*boxxsize
2974 yj=yj_safe+yshift*boxysize
2975 zj=zj_safe+zshift*boxzsize
2976 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2977 if(dist_temp.lt.dist_init) then
2987 if (subchap.eq.1) then
2996 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2997 C sss is scaling function for smoothing the cutoff gradient otherwise
2998 C the gradient would not be continuouse
2999 sss=sscale(1.0d0/(dsqrt(rrij)))
3000 if (sss.le.0.0d0) cycle
3001 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3003 e1=fac*fac*aad(itypj,iteli)
3004 e2=fac*bad(itypj,iteli)
3005 if (iabs(j-i) .le. 2) then
3008 evdw2_14=evdw2_14+(e1+e2)*sss
3011 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3012 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3013 c & bad(itypj,iteli)
3014 evdw2=evdw2+evdwij*sss
3017 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3019 fac=-(evdwij+e1)*rrij*sss
3020 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3025 cd write (iout,*) 'j<i'
3026 C Uncomment following three lines for SC-p interactions
3028 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3031 cd write (iout,*) 'j>i'
3034 C Uncomment following line for SC-p interactions
3035 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3039 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3043 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3044 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3047 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3057 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3058 gradx_scp(j,i)=expon*gradx_scp(j,i)
3061 C******************************************************************************
3065 C To save time the factor EXPON has been extracted from ALL components
3066 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3069 C******************************************************************************
3072 C--------------------------------------------------------------------------
3073 subroutine edis(ehpb)
3075 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3077 implicit real*8 (a-h,o-z)
3078 include 'DIMENSIONS'
3079 include 'DIMENSIONS.ZSCOPT'
3080 include 'COMMON.SBRIDGE'
3081 include 'COMMON.CHAIN'
3082 include 'COMMON.DERIV'
3083 include 'COMMON.VAR'
3084 include 'COMMON.INTERACT'
3087 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3088 cd print *,'link_start=',link_start,' link_end=',link_end
3089 if (link_end.eq.0) return
3090 do i=link_start,link_end
3091 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3092 C CA-CA distance used in regularization of structure.
3095 C iii and jjj point to the residues for which the distance is assigned.
3096 if (ii.gt.nres) then
3103 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3104 C distance and angle dependent SS bond potential.
3105 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3106 & iabs(itype(jjj)).eq.1) then
3107 call ssbond_ene(iii,jjj,eij)
3110 C Calculate the distance between the two points and its difference from the
3114 C Get the force constant corresponding to this distance.
3116 C Calculate the contribution to energy.
3117 ehpb=ehpb+waga*rdis*rdis
3119 C Evaluate gradient.
3122 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3123 cd & ' waga=',waga,' fac=',fac
3125 ggg(j)=fac*(c(j,jj)-c(j,ii))
3127 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3128 C If this is a SC-SC distance, we need to calculate the contributions to the
3129 C Cartesian gradient in the SC vectors (ghpbx).
3132 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3133 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3138 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3146 C--------------------------------------------------------------------------
3147 subroutine ssbond_ene(i,j,eij)
3149 C Calculate the distance and angle dependent SS-bond potential energy
3150 C using a free-energy function derived based on RHF/6-31G** ab initio
3151 C calculations of diethyl disulfide.
3153 C A. Liwo and U. Kozlowska, 11/24/03
3155 implicit real*8 (a-h,o-z)
3156 include 'DIMENSIONS'
3157 include 'DIMENSIONS.ZSCOPT'
3158 include 'COMMON.SBRIDGE'
3159 include 'COMMON.CHAIN'
3160 include 'COMMON.DERIV'
3161 include 'COMMON.LOCAL'
3162 include 'COMMON.INTERACT'
3163 include 'COMMON.VAR'
3164 include 'COMMON.IOUNITS'
3165 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3166 itypi=iabs(itype(i))
3170 dxi=dc_norm(1,nres+i)
3171 dyi=dc_norm(2,nres+i)
3172 dzi=dc_norm(3,nres+i)
3173 dsci_inv=dsc_inv(itypi)
3174 itypj=iabs(itype(j))
3175 dscj_inv=dsc_inv(itypj)
3179 dxj=dc_norm(1,nres+j)
3180 dyj=dc_norm(2,nres+j)
3181 dzj=dc_norm(3,nres+j)
3182 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3187 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3188 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3189 om12=dxi*dxj+dyi*dyj+dzi*dzj
3191 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3192 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3198 deltat12=om2-om1+2.0d0
3200 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3201 & +akct*deltad*deltat12
3202 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3203 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3204 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3205 c & " deltat12",deltat12," eij",eij
3206 ed=2*akcm*deltad+akct*deltat12
3208 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3209 eom1=-2*akth*deltat1-pom1-om2*pom2
3210 eom2= 2*akth*deltat2+pom1-om1*pom2
3213 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3216 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3217 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3218 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3219 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3222 C Calculate the components of the gradient in DC and X
3226 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3231 C--------------------------------------------------------------------------
3232 subroutine ebond(estr)
3234 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3236 implicit real*8 (a-h,o-z)
3237 include 'DIMENSIONS'
3238 include 'DIMENSIONS.ZSCOPT'
3239 include 'COMMON.LOCAL'
3240 include 'COMMON.GEO'
3241 include 'COMMON.INTERACT'
3242 include 'COMMON.DERIV'
3243 include 'COMMON.VAR'
3244 include 'COMMON.CHAIN'
3245 include 'COMMON.IOUNITS'
3246 include 'COMMON.NAMES'
3247 include 'COMMON.FFIELD'
3248 include 'COMMON.CONTROL'
3249 logical energy_dec /.false./
3250 double precision u(3),ud(3)
3253 c write (iout,*) "distchainmax",distchainmax
3255 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
3256 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3258 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3259 C & *dc(j,i-1)/vbld(i)
3261 C if (energy_dec) write(iout,*)
3262 C & "estr1",i,vbld(i),distchainmax,
3263 C & gnmr1(vbld(i),-1.0d0,distchainmax)
3265 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
3266 diff = vbld(i)-vbldpDUM
3268 diff = vbld(i)-vbldp0
3269 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3272 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3277 estr=0.5d0*AKP*estr+estr1
3279 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3283 if (iti.ne.10 .and. iti.ne.ntyp1) then
3286 diff=vbld(i+nres)-vbldsc0(1,iti)
3287 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3288 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3289 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3291 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3295 diff=vbld(i+nres)-vbldsc0(j,iti)
3296 ud(j)=aksc(j,iti)*diff
3297 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3311 uprod2=uprod2*u(k)*u(k)
3315 usumsqder=usumsqder+ud(j)*uprod2
3317 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3318 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3319 estr=estr+uprod/usum
3321 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3329 C--------------------------------------------------------------------------
3330 subroutine ebend(etheta)
3332 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3333 C angles gamma and its derivatives in consecutive thetas and gammas.
3335 implicit real*8 (a-h,o-z)
3336 include 'DIMENSIONS'
3337 include 'DIMENSIONS.ZSCOPT'
3338 include 'COMMON.LOCAL'
3339 include 'COMMON.GEO'
3340 include 'COMMON.INTERACT'
3341 include 'COMMON.DERIV'
3342 include 'COMMON.VAR'
3343 include 'COMMON.CHAIN'
3344 include 'COMMON.IOUNITS'
3345 include 'COMMON.NAMES'
3346 include 'COMMON.FFIELD'
3347 common /calcthet/ term1,term2,termm,diffak,ratak,
3348 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3349 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3350 double precision y(2),z(2)
3352 time11=dexp(-2*time)
3355 c write (iout,*) "nres",nres
3356 c write (*,'(a,i2)') 'EBEND ICG=',icg
3357 c write (iout,*) ithet_start,ithet_end
3358 do i=ithet_start,ithet_end
3359 C if (itype(i-1).eq.ntyp1) cycle
3360 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3361 & .or.itype(i).eq.ntyp1) cycle
3362 C Zero the energy function and its derivative at 0 or pi.
3363 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3365 ichir1=isign(1,itype(i-2))
3366 ichir2=isign(1,itype(i))
3367 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
3368 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
3369 if (itype(i-1).eq.10) then
3370 itype1=isign(10,itype(i-2))
3371 ichir11=isign(1,itype(i-2))
3372 ichir12=isign(1,itype(i-2))
3373 itype2=isign(10,itype(i))
3374 ichir21=isign(1,itype(i))
3375 ichir22=isign(1,itype(i))
3378 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3382 call proc_proc(phii,icrc)
3383 if (icrc.eq.1) phii=150.0
3393 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3397 call proc_proc(phii1,icrc)
3398 if (icrc.eq.1) phii1=150.0
3410 C Calculate the "mean" value of theta from the part of the distribution
3411 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3412 C In following comments this theta will be referred to as t_c.
3413 thet_pred_mean=0.0d0
3415 athetk=athet(k,it,ichir1,ichir2)
3416 bthetk=bthet(k,it,ichir1,ichir2)
3418 athetk=athet(k,itype1,ichir11,ichir12)
3419 bthetk=bthet(k,itype2,ichir21,ichir22)
3421 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3423 c write (iout,*) "thet_pred_mean",thet_pred_mean
3424 dthett=thet_pred_mean*ssd
3425 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3426 c write (iout,*) "thet_pred_mean",thet_pred_mean
3427 C Derivatives of the "mean" values in gamma1 and gamma2.
3428 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
3429 &+athet(2,it,ichir1,ichir2)*y(1))*ss
3430 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
3431 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
3433 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
3434 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
3435 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
3436 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
3438 if (theta(i).gt.pi-delta) then
3439 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3441 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3442 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3443 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3445 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3447 else if (theta(i).lt.delta) then
3448 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3449 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3450 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3452 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3453 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3456 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3459 etheta=etheta+ethetai
3460 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3461 c & rad2deg*phii,rad2deg*phii1,ethetai
3462 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3463 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3464 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3467 C Ufff.... We've done all this!!!
3470 C---------------------------------------------------------------------------
3471 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3473 implicit real*8 (a-h,o-z)
3474 include 'DIMENSIONS'
3475 include 'COMMON.LOCAL'
3476 include 'COMMON.IOUNITS'
3477 common /calcthet/ term1,term2,termm,diffak,ratak,
3478 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3479 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3480 C Calculate the contributions to both Gaussian lobes.
3481 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3482 C The "polynomial part" of the "standard deviation" of this part of
3486 sig=sig*thet_pred_mean+polthet(j,it)
3488 C Derivative of the "interior part" of the "standard deviation of the"
3489 C gamma-dependent Gaussian lobe in t_c.
3490 sigtc=3*polthet(3,it)
3492 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3495 C Set the parameters of both Gaussian lobes of the distribution.
3496 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3497 fac=sig*sig+sigc0(it)
3500 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3501 sigsqtc=-4.0D0*sigcsq*sigtc
3502 c print *,i,sig,sigtc,sigsqtc
3503 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3504 sigtc=-sigtc/(fac*fac)
3505 C Following variable is sigma(t_c)**(-2)
3506 sigcsq=sigcsq*sigcsq
3508 sig0inv=1.0D0/sig0i**2
3509 delthec=thetai-thet_pred_mean
3510 delthe0=thetai-theta0i
3511 term1=-0.5D0*sigcsq*delthec*delthec
3512 term2=-0.5D0*sig0inv*delthe0*delthe0
3513 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3514 C NaNs in taking the logarithm. We extract the largest exponent which is added
3515 C to the energy (this being the log of the distribution) at the end of energy
3516 C term evaluation for this virtual-bond angle.
3517 if (term1.gt.term2) then
3519 term2=dexp(term2-termm)
3523 term1=dexp(term1-termm)
3526 C The ratio between the gamma-independent and gamma-dependent lobes of
3527 C the distribution is a Gaussian function of thet_pred_mean too.
3528 diffak=gthet(2,it)-thet_pred_mean
3529 ratak=diffak/gthet(3,it)**2
3530 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3531 C Let's differentiate it in thet_pred_mean NOW.
3533 C Now put together the distribution terms to make complete distribution.
3534 termexp=term1+ak*term2
3535 termpre=sigc+ak*sig0i
3536 C Contribution of the bending energy from this theta is just the -log of
3537 C the sum of the contributions from the two lobes and the pre-exponential
3538 C factor. Simple enough, isn't it?
3539 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3540 C NOW the derivatives!!!
3541 C 6/6/97 Take into account the deformation.
3542 E_theta=(delthec*sigcsq*term1
3543 & +ak*delthe0*sig0inv*term2)/termexp
3544 E_tc=((sigtc+aktc*sig0i)/termpre
3545 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3546 & aktc*term2)/termexp)
3549 c-----------------------------------------------------------------------------
3550 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3551 implicit real*8 (a-h,o-z)
3552 include 'DIMENSIONS'
3553 include 'COMMON.LOCAL'
3554 include 'COMMON.IOUNITS'
3555 common /calcthet/ term1,term2,termm,diffak,ratak,
3556 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3557 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3558 delthec=thetai-thet_pred_mean
3559 delthe0=thetai-theta0i
3560 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3561 t3 = thetai-thet_pred_mean
3565 t14 = t12+t6*sigsqtc
3567 t21 = thetai-theta0i
3573 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3574 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3575 & *(-t12*t9-ak*sig0inv*t27)
3579 C--------------------------------------------------------------------------
3580 subroutine ebend(etheta)
3582 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3583 C angles gamma and its derivatives in consecutive thetas and gammas.
3584 C ab initio-derived potentials from
3585 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3587 implicit real*8 (a-h,o-z)
3588 include 'DIMENSIONS'
3589 include 'DIMENSIONS.ZSCOPT'
3590 include 'COMMON.LOCAL'
3591 include 'COMMON.GEO'
3592 include 'COMMON.INTERACT'
3593 include 'COMMON.DERIV'
3594 include 'COMMON.VAR'
3595 include 'COMMON.CHAIN'
3596 include 'COMMON.IOUNITS'
3597 include 'COMMON.NAMES'
3598 include 'COMMON.FFIELD'
3599 include 'COMMON.CONTROL'
3600 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3601 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3602 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3603 & sinph1ph2(maxdouble,maxdouble)
3604 logical lprn /.false./, lprn1 /.false./
3606 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3607 do i=ithet_start,ithet_end
3608 C if (itype(i-1).eq.ntyp1) cycle
3609 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
3610 & .or.itype(i).eq.ntyp1) cycle
3611 if (iabs(itype(i+1)).eq.20) iblock=2
3612 if (iabs(itype(i+1)).ne.20) iblock=1
3616 theti2=0.5d0*theta(i)
3617 ityp2=ithetyp((itype(i-1)))
3619 coskt(k)=dcos(k*theti2)
3620 sinkt(k)=dsin(k*theti2)
3622 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
3625 if (phii.ne.phii) phii=150.0
3629 ityp1=ithetyp((itype(i-2)))
3631 cosph1(k)=dcos(k*phii)
3632 sinph1(k)=dsin(k*phii)
3642 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3645 if (phii1.ne.phii1) phii1=150.0
3650 ityp3=ithetyp((itype(i)))
3652 cosph2(k)=dcos(k*phii1)
3653 sinph2(k)=dsin(k*phii1)
3663 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3664 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3666 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
3669 ccl=cosph1(l)*cosph2(k-l)
3670 ssl=sinph1(l)*sinph2(k-l)
3671 scl=sinph1(l)*cosph2(k-l)
3672 csl=cosph1(l)*sinph2(k-l)
3673 cosph1ph2(l,k)=ccl-ssl
3674 cosph1ph2(k,l)=ccl+ssl
3675 sinph1ph2(l,k)=scl+csl
3676 sinph1ph2(k,l)=scl-csl
3680 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3681 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3682 write (iout,*) "coskt and sinkt"
3684 write (iout,*) k,coskt(k),sinkt(k)
3688 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
3689 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
3692 & write (iout,*) "k",k,"
3693 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
3694 & " ethetai",ethetai
3697 write (iout,*) "cosph and sinph"
3699 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3701 write (iout,*) "cosph1ph2 and sinph2ph2"
3704 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3705 & sinph1ph2(l,k),sinph1ph2(k,l)
3708 write(iout,*) "ethetai",ethetai
3712 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
3713 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
3714 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
3715 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
3716 ethetai=ethetai+sinkt(m)*aux
3717 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3718 dephii=dephii+k*sinkt(m)*(
3719 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
3720 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
3721 dephii1=dephii1+k*sinkt(m)*(
3722 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
3723 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
3725 & write (iout,*) "m",m," k",k," bbthet",
3726 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
3727 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
3728 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
3729 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
3733 & write(iout,*) "ethetai",ethetai
3737 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3738 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
3739 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3740 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
3741 ethetai=ethetai+sinkt(m)*aux
3742 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3743 dephii=dephii+l*sinkt(m)*(
3744 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
3745 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3746 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
3747 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3748 dephii1=dephii1+(k-l)*sinkt(m)*(
3749 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
3750 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
3751 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
3752 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
3754 write (iout,*) "m",m," k",k," l",l," ffthet",
3755 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3756 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
3757 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
3758 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
3759 & " ethetai",ethetai
3760 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3761 & cosph1ph2(k,l)*sinkt(m),
3762 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3768 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3769 & i,theta(i)*rad2deg,phii*rad2deg,
3770 & phii1*rad2deg,ethetai
3771 etheta=etheta+ethetai
3772 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3773 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3774 gloc(nphi+i-2,icg)=wang*dethetai
3780 c-----------------------------------------------------------------------------
3781 subroutine esc(escloc)
3782 C Calculate the local energy of a side chain and its derivatives in the
3783 C corresponding virtual-bond valence angles THETA and the spherical angles
3785 implicit real*8 (a-h,o-z)
3786 include 'DIMENSIONS'
3787 include 'DIMENSIONS.ZSCOPT'
3788 include 'COMMON.GEO'
3789 include 'COMMON.LOCAL'
3790 include 'COMMON.VAR'
3791 include 'COMMON.INTERACT'
3792 include 'COMMON.DERIV'
3793 include 'COMMON.CHAIN'
3794 include 'COMMON.IOUNITS'
3795 include 'COMMON.NAMES'
3796 include 'COMMON.FFIELD'
3797 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3798 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3799 common /sccalc/ time11,time12,time112,theti,it,nlobit
3802 c write (iout,'(a)') 'ESC'
3803 do i=loc_start,loc_end
3805 if (it.eq.ntyp1) cycle
3806 if (it.eq.10) goto 1
3807 nlobit=nlob(iabs(it))
3808 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3809 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3810 theti=theta(i+1)-pipol
3814 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3816 if (x(2).gt.pi-delta) then
3820 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3822 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3823 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3825 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3826 & ddersc0(1),dersc(1))
3827 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3828 & ddersc0(3),dersc(3))
3830 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3832 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3833 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3834 & dersc0(2),esclocbi,dersc02)
3835 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3837 call splinthet(x(2),0.5d0*delta,ss,ssd)
3842 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3844 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3845 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3847 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3849 c write (iout,*) escloci
3850 else if (x(2).lt.delta) then
3854 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3856 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3857 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3859 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3860 & ddersc0(1),dersc(1))
3861 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3862 & ddersc0(3),dersc(3))
3864 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3866 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3867 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3868 & dersc0(2),esclocbi,dersc02)
3869 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3874 call splinthet(x(2),0.5d0*delta,ss,ssd)
3876 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3878 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3879 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3881 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3882 c write (iout,*) escloci
3884 call enesc(x,escloci,dersc,ddummy,.false.)
3887 escloc=escloc+escloci
3888 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3890 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3892 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3893 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3898 C---------------------------------------------------------------------------
3899 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3900 implicit real*8 (a-h,o-z)
3901 include 'DIMENSIONS'
3902 include 'COMMON.GEO'
3903 include 'COMMON.LOCAL'
3904 include 'COMMON.IOUNITS'
3905 common /sccalc/ time11,time12,time112,theti,it,nlobit
3906 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3907 double precision contr(maxlob,-1:1)
3909 c write (iout,*) 'it=',it,' nlobit=',nlobit
3913 if (mixed) ddersc(j)=0.0d0
3917 C Because of periodicity of the dependence of the SC energy in omega we have
3918 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3919 C To avoid underflows, first compute & store the exponents.
3927 z(k)=x(k)-censc(k,j,it)
3932 Axk=Axk+gaussc(l,k,j,it)*z(l)
3938 expfac=expfac+Ax(k,j,iii)*z(k)
3946 C As in the case of ebend, we want to avoid underflows in exponentiation and
3947 C subsequent NaNs and INFs in energy calculation.
3948 C Find the largest exponent
3952 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3956 cd print *,'it=',it,' emin=',emin
3958 C Compute the contribution to SC energy and derivatives
3962 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
3963 cd print *,'j=',j,' expfac=',expfac
3964 escloc_i=escloc_i+expfac
3966 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3970 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3971 & +gaussc(k,2,j,it))*expfac
3978 dersc(1)=dersc(1)/cos(theti)**2
3979 ddersc(1)=ddersc(1)/cos(theti)**2
3982 escloci=-(dlog(escloc_i)-emin)
3984 dersc(j)=dersc(j)/escloc_i
3988 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3993 C------------------------------------------------------------------------------
3994 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3995 implicit real*8 (a-h,o-z)
3996 include 'DIMENSIONS'
3997 include 'COMMON.GEO'
3998 include 'COMMON.LOCAL'
3999 include 'COMMON.IOUNITS'
4000 common /sccalc/ time11,time12,time112,theti,it,nlobit
4001 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4002 double precision contr(maxlob)
4013 z(k)=x(k)-censc(k,j,it)
4019 Axk=Axk+gaussc(l,k,j,it)*z(l)
4025 expfac=expfac+Ax(k,j)*z(k)
4030 C As in the case of ebend, we want to avoid underflows in exponentiation and
4031 C subsequent NaNs and INFs in energy calculation.
4032 C Find the largest exponent
4035 if (emin.gt.contr(j)) emin=contr(j)
4039 C Compute the contribution to SC energy and derivatives
4043 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4044 escloc_i=escloc_i+expfac
4046 dersc(k)=dersc(k)+Ax(k,j)*expfac
4048 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4049 & +gaussc(1,2,j,it))*expfac
4053 dersc(1)=dersc(1)/cos(theti)**2
4054 dersc12=dersc12/cos(theti)**2
4055 escloci=-(dlog(escloc_i)-emin)
4057 dersc(j)=dersc(j)/escloc_i
4059 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4063 c----------------------------------------------------------------------------------
4064 subroutine esc(escloc)
4065 C Calculate the local energy of a side chain and its derivatives in the
4066 C corresponding virtual-bond valence angles THETA and the spherical angles
4067 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4068 C added by Urszula Kozlowska. 07/11/2007
4070 implicit real*8 (a-h,o-z)
4071 include 'DIMENSIONS'
4072 include 'DIMENSIONS.ZSCOPT'
4073 include 'COMMON.GEO'
4074 include 'COMMON.LOCAL'
4075 include 'COMMON.VAR'
4076 include 'COMMON.SCROT'
4077 include 'COMMON.INTERACT'
4078 include 'COMMON.DERIV'
4079 include 'COMMON.CHAIN'
4080 include 'COMMON.IOUNITS'
4081 include 'COMMON.NAMES'
4082 include 'COMMON.FFIELD'
4083 include 'COMMON.CONTROL'
4084 include 'COMMON.VECTORS'
4085 double precision x_prime(3),y_prime(3),z_prime(3)
4086 & , sumene,dsc_i,dp2_i,x(65),
4087 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4088 & de_dxx,de_dyy,de_dzz,de_dt
4089 double precision s1_t,s1_6_t,s2_t,s2_6_t
4091 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4092 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4093 & dt_dCi(3),dt_dCi1(3)
4094 common /sccalc/ time11,time12,time112,theti,it,nlobit
4097 do i=loc_start,loc_end
4098 if (itype(i).eq.ntyp1) cycle
4099 costtab(i+1) =dcos(theta(i+1))
4100 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4101 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4102 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4103 cosfac2=0.5d0/(1.0d0+costtab(i+1))
4104 cosfac=dsqrt(cosfac2)
4105 sinfac2=0.5d0/(1.0d0-costtab(i+1))
4106 sinfac=dsqrt(sinfac2)
4108 if (it.eq.10) goto 1
4110 C Compute the axes of tghe local cartesian coordinates system; store in
4111 c x_prime, y_prime and z_prime
4118 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4119 C & dc_norm(3,i+nres)
4121 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4122 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4125 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
4128 c write (2,*) "x_prime",(x_prime(j),j=1,3)
4129 c write (2,*) "y_prime",(y_prime(j),j=1,3)
4130 c write (2,*) "z_prime",(z_prime(j),j=1,3)
4131 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4132 c & " xy",scalar(x_prime(1),y_prime(1)),
4133 c & " xz",scalar(x_prime(1),z_prime(1)),
4134 c & " yy",scalar(y_prime(1),y_prime(1)),
4135 c & " yz",scalar(y_prime(1),z_prime(1)),
4136 c & " zz",scalar(z_prime(1),z_prime(1))
4138 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4139 C to local coordinate system. Store in xx, yy, zz.
4145 xx = xx + x_prime(j)*dc_norm(j,i+nres)
4146 yy = yy + y_prime(j)*dc_norm(j,i+nres)
4147 zz = zz + z_prime(j)*dc_norm(j,i+nres)
4154 C Compute the energy of the ith side cbain
4156 c write (2,*) "xx",xx," yy",yy," zz",zz
4159 x(j) = sc_parmin(j,it)
4162 Cc diagnostics - remove later
4164 yy1 = dsin(alph(2))*dcos(omeg(2))
4165 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
4166 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4167 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4169 C," --- ", xx_w,yy_w,zz_w
4172 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
4173 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
4175 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4176 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4178 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4179 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4180 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4181 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4182 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4184 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4185 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4186 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4187 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4188 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4190 dsc_i = 0.743d0+x(61)
4192 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4193 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4194 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4195 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4196 s1=(1+x(63))/(0.1d0 + dscp1)
4197 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4198 s2=(1+x(65))/(0.1d0 + dscp2)
4199 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4200 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4201 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4202 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4204 c & dscp1,dscp2,sumene
4205 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4206 escloc = escloc + sumene
4207 c write (2,*) "escloc",escloc
4208 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
4210 if (.not. calc_grad) goto 1
4213 C This section to check the numerical derivatives of the energy of ith side
4214 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4215 C #define DEBUG in the code to turn it on.
4217 write (2,*) "sumene =",sumene
4221 write (2,*) xx,yy,zz
4222 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4223 de_dxx_num=(sumenep-sumene)/aincr
4225 write (2,*) "xx+ sumene from enesc=",sumenep
4228 write (2,*) xx,yy,zz
4229 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4230 de_dyy_num=(sumenep-sumene)/aincr
4232 write (2,*) "yy+ sumene from enesc=",sumenep
4235 write (2,*) xx,yy,zz
4236 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4237 de_dzz_num=(sumenep-sumene)/aincr
4239 write (2,*) "zz+ sumene from enesc=",sumenep
4240 costsave=cost2tab(i+1)
4241 sintsave=sint2tab(i+1)
4242 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4243 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4244 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4245 de_dt_num=(sumenep-sumene)/aincr
4246 write (2,*) " t+ sumene from enesc=",sumenep
4247 cost2tab(i+1)=costsave
4248 sint2tab(i+1)=sintsave
4249 C End of diagnostics section.
4252 C Compute the gradient of esc
4254 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4255 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4256 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4257 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4258 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4259 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4260 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4261 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4262 pom1=(sumene3*sint2tab(i+1)+sumene1)
4263 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4264 pom2=(sumene4*cost2tab(i+1)+sumene2)
4265 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4266 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4267 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4268 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4270 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4271 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4272 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4274 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4275 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4276 & +(pom1+pom2)*pom_dx
4278 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4281 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4282 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4283 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4285 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4286 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4287 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4288 & +x(59)*zz**2 +x(60)*xx*zz
4289 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4290 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4291 & +(pom1-pom2)*pom_dy
4293 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4296 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4297 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4298 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4299 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4300 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4301 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4302 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4303 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4305 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4308 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4309 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4310 & +pom1*pom_dt1+pom2*pom_dt2
4312 write(2,*), "de_dt = ", de_dt,de_dt_num
4316 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4317 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4318 cosfac2xx=cosfac2*xx
4319 sinfac2yy=sinfac2*yy
4321 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4323 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4325 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4326 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4327 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4328 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4329 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4330 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4331 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4332 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4333 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4334 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4338 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
4339 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4340 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
4341 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
4344 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4345 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4346 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4348 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4349 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4353 dXX_Ctab(k,i)=dXX_Ci(k)
4354 dXX_C1tab(k,i)=dXX_Ci1(k)
4355 dYY_Ctab(k,i)=dYY_Ci(k)
4356 dYY_C1tab(k,i)=dYY_Ci1(k)
4357 dZZ_Ctab(k,i)=dZZ_Ci(k)
4358 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4359 dXX_XYZtab(k,i)=dXX_XYZ(k)
4360 dYY_XYZtab(k,i)=dYY_XYZ(k)
4361 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4365 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4366 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4367 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4368 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4369 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4371 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4372 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4373 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4374 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4375 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4376 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4377 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4378 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4380 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4381 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4383 C to check gradient call subroutine check_grad
4390 c------------------------------------------------------------------------------
4391 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4393 C This procedure calculates two-body contact function g(rij) and its derivative:
4396 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4399 C where x=(rij-r0ij)/delta
4401 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4404 double precision rij,r0ij,eps0ij,fcont,fprimcont
4405 double precision x,x2,x4,delta
4409 if (x.lt.-1.0D0) then
4412 else if (x.le.1.0D0) then
4415 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4416 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4423 c------------------------------------------------------------------------------
4424 subroutine splinthet(theti,delta,ss,ssder)
4425 implicit real*8 (a-h,o-z)
4426 include 'DIMENSIONS'
4427 include 'DIMENSIONS.ZSCOPT'
4428 include 'COMMON.VAR'
4429 include 'COMMON.GEO'
4432 if (theti.gt.pipol) then
4433 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4435 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4440 c------------------------------------------------------------------------------
4441 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4443 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4444 double precision ksi,ksi2,ksi3,a1,a2,a3
4445 a1=fprim0*delta/(f1-f0)
4451 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4452 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4455 c------------------------------------------------------------------------------
4456 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4458 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4459 double precision ksi,ksi2,ksi3,a1,a2,a3
4464 a2=3*(f1x-f0x)-2*fprim0x*delta
4465 a3=fprim0x*delta-2*(f1x-f0x)
4466 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4469 C-----------------------------------------------------------------------------
4471 C-----------------------------------------------------------------------------
4472 subroutine etor(etors,edihcnstr,fact)
4473 implicit real*8 (a-h,o-z)
4474 include 'DIMENSIONS'
4475 include 'DIMENSIONS.ZSCOPT'
4476 include 'COMMON.VAR'
4477 include 'COMMON.GEO'
4478 include 'COMMON.LOCAL'
4479 include 'COMMON.TORSION'
4480 include 'COMMON.INTERACT'
4481 include 'COMMON.DERIV'
4482 include 'COMMON.CHAIN'
4483 include 'COMMON.NAMES'
4484 include 'COMMON.IOUNITS'
4485 include 'COMMON.FFIELD'
4486 include 'COMMON.TORCNSTR'
4488 C Set lprn=.true. for debugging
4492 do i=iphi_start,iphi_end
4493 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4494 & .or. itype(i).eq.ntyp1) cycle
4495 itori=itortyp(itype(i-2))
4496 itori1=itortyp(itype(i-1))
4499 C Proline-Proline pair is a special case...
4500 if (itori.eq.3 .and. itori1.eq.3) then
4501 if (phii.gt.-dwapi3) then
4503 fac=1.0D0/(1.0D0-cosphi)
4504 etorsi=v1(1,3,3)*fac
4505 etorsi=etorsi+etorsi
4506 etors=etors+etorsi-v1(1,3,3)
4507 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4510 v1ij=v1(j+1,itori,itori1)
4511 v2ij=v2(j+1,itori,itori1)
4514 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4515 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4519 v1ij=v1(j,itori,itori1)
4520 v2ij=v2(j,itori,itori1)
4523 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4524 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4528 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4529 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4530 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4531 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4532 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4534 ! 6/20/98 - dihedral angle constraints
4537 itori=idih_constr(i)
4540 if (difi.gt.drange(i)) then
4542 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4543 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4544 else if (difi.lt.-drange(i)) then
4546 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4547 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4549 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4550 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4552 ! write (iout,*) 'edihcnstr',edihcnstr
4555 c------------------------------------------------------------------------------
4557 subroutine etor(etors,edihcnstr,fact)
4558 implicit real*8 (a-h,o-z)
4559 include 'DIMENSIONS'
4560 include 'DIMENSIONS.ZSCOPT'
4561 include 'COMMON.VAR'
4562 include 'COMMON.GEO'
4563 include 'COMMON.LOCAL'
4564 include 'COMMON.TORSION'
4565 include 'COMMON.INTERACT'
4566 include 'COMMON.DERIV'
4567 include 'COMMON.CHAIN'
4568 include 'COMMON.NAMES'
4569 include 'COMMON.IOUNITS'
4570 include 'COMMON.FFIELD'
4571 include 'COMMON.TORCNSTR'
4573 C Set lprn=.true. for debugging
4577 do i=iphi_start,iphi_end
4578 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4579 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
4580 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
4581 C & .or. itype(i).eq.ntyp1) cycle
4582 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4583 if (iabs(itype(i)).eq.20) then
4588 itori=itortyp(itype(i-2))
4589 itori1=itortyp(itype(i-1))
4592 C Regular cosine and sine terms
4593 do j=1,nterm(itori,itori1,iblock)
4594 v1ij=v1(j,itori,itori1,iblock)
4595 v2ij=v2(j,itori,itori1,iblock)
4598 etors=etors+v1ij*cosphi+v2ij*sinphi
4599 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4603 C E = SUM ----------------------------------- - v1
4604 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4606 cosphi=dcos(0.5d0*phii)
4607 sinphi=dsin(0.5d0*phii)
4608 do j=1,nlor(itori,itori1,iblock)
4609 vl1ij=vlor1(j,itori,itori1)
4610 vl2ij=vlor2(j,itori,itori1)
4611 vl3ij=vlor3(j,itori,itori1)
4612 pom=vl2ij*cosphi+vl3ij*sinphi
4613 pom1=1.0d0/(pom*pom+1.0d0)
4614 etors=etors+vl1ij*pom1
4615 c if (energy_dec) etors_ii=etors_ii+
4618 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4620 C Subtract the constant term
4621 etors=etors-v0(itori,itori1,iblock)
4623 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4624 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4625 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
4626 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4627 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4630 ! 6/20/98 - dihedral angle constraints
4633 itori=idih_constr(i)
4635 difi=pinorm(phii-phi0(i))
4637 if (difi.gt.drange(i)) then
4639 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4640 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4641 edihi=0.25d0*ftors*difi**4
4642 else if (difi.lt.-drange(i)) then
4644 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4645 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4646 edihi=0.25d0*ftors*difi**4
4650 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4652 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4653 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4655 ! write (iout,*) 'edihcnstr',edihcnstr
4658 c----------------------------------------------------------------------------
4659 subroutine etor_d(etors_d,fact2)
4660 C 6/23/01 Compute double torsional energy
4661 implicit real*8 (a-h,o-z)
4662 include 'DIMENSIONS'
4663 include 'DIMENSIONS.ZSCOPT'
4664 include 'COMMON.VAR'
4665 include 'COMMON.GEO'
4666 include 'COMMON.LOCAL'
4667 include 'COMMON.TORSION'
4668 include 'COMMON.INTERACT'
4669 include 'COMMON.DERIV'
4670 include 'COMMON.CHAIN'
4671 include 'COMMON.NAMES'
4672 include 'COMMON.IOUNITS'
4673 include 'COMMON.FFIELD'
4674 include 'COMMON.TORCNSTR'
4676 C Set lprn=.true. for debugging
4680 do i=iphi_start,iphi_end-1
4681 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
4682 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4683 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
4684 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
4685 & (itype(i+1).eq.ntyp1)) cycle
4686 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4688 itori=itortyp(itype(i-2))
4689 itori1=itortyp(itype(i-1))
4690 itori2=itortyp(itype(i))
4696 if (iabs(itype(i+1)).eq.20) iblock=2
4697 C Regular cosine and sine terms
4698 do j=1,ntermd_1(itori,itori1,itori2,iblock)
4699 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
4700 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
4701 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
4702 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
4703 cosphi1=dcos(j*phii)
4704 sinphi1=dsin(j*phii)
4705 cosphi2=dcos(j*phii1)
4706 sinphi2=dsin(j*phii1)
4707 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4708 & v2cij*cosphi2+v2sij*sinphi2
4709 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4710 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4712 do k=2,ntermd_2(itori,itori1,itori2,iblock)
4714 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
4715 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
4716 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
4717 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
4718 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4719 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4720 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4721 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4722 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4723 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4724 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4725 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4726 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4727 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4730 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4731 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4737 c------------------------------------------------------------------------------
4738 subroutine eback_sc_corr(esccor)
4739 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4740 c conformational states; temporarily implemented as differences
4741 c between UNRES torsional potentials (dependent on three types of
4742 c residues) and the torsional potentials dependent on all 20 types
4743 c of residues computed from AM1 energy surfaces of terminally-blocked
4744 c amino-acid residues.
4745 implicit real*8 (a-h,o-z)
4746 include 'DIMENSIONS'
4747 include 'DIMENSIONS.ZSCOPT'
4748 include 'COMMON.VAR'
4749 include 'COMMON.GEO'
4750 include 'COMMON.LOCAL'
4751 include 'COMMON.TORSION'
4752 include 'COMMON.SCCOR'
4753 include 'COMMON.INTERACT'
4754 include 'COMMON.DERIV'
4755 include 'COMMON.CHAIN'
4756 include 'COMMON.NAMES'
4757 include 'COMMON.IOUNITS'
4758 include 'COMMON.FFIELD'
4759 include 'COMMON.CONTROL'
4761 C Set lprn=.true. for debugging
4764 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4766 do i=itau_start,itau_end
4767 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4769 isccori=isccortyp(itype(i-2))
4770 isccori1=isccortyp(itype(i-1))
4772 do intertyp=1,3 !intertyp
4773 cc Added 09 May 2012 (Adasko)
4774 cc Intertyp means interaction type of backbone mainchain correlation:
4775 c 1 = SC...Ca...Ca...Ca
4776 c 2 = Ca...Ca...Ca...SC
4777 c 3 = SC...Ca...Ca...SCi
4779 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4780 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4781 & (itype(i-1).eq.ntyp1)))
4782 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4783 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4784 & .or.(itype(i).eq.ntyp1)))
4785 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4786 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4787 & (itype(i-3).eq.ntyp1)))) cycle
4788 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4789 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4791 do j=1,nterm_sccor(isccori,isccori1)
4792 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4793 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4794 cosphi=dcos(j*tauangle(intertyp,i))
4795 sinphi=dsin(j*tauangle(intertyp,i))
4796 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4797 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4799 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4800 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4801 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4803 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4804 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4805 & (v1sccor(j,1,itori,itori1),j=1,6)
4806 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4807 c gsccor_loc(i-3)=gloci
4812 c------------------------------------------------------------------------------
4813 subroutine multibody(ecorr)
4814 C This subroutine calculates multi-body contributions to energy following
4815 C the idea of Skolnick et al. If side chains I and J make a contact and
4816 C at the same time side chains I+1 and J+1 make a contact, an extra
4817 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4818 implicit real*8 (a-h,o-z)
4819 include 'DIMENSIONS'
4820 include 'COMMON.IOUNITS'
4821 include 'COMMON.DERIV'
4822 include 'COMMON.INTERACT'
4823 include 'COMMON.CONTACTS'
4824 double precision gx(3),gx1(3)
4827 C Set lprn=.true. for debugging
4831 write (iout,'(a)') 'Contact function values:'
4833 write (iout,'(i2,20(1x,i2,f10.5))')
4834 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4849 num_conti=num_cont(i)
4850 num_conti1=num_cont(i1)
4855 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4856 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4857 cd & ' ishift=',ishift
4858 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4859 C The system gains extra energy.
4860 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4861 endif ! j1==j+-ishift
4870 c------------------------------------------------------------------------------
4871 double precision function esccorr(i,j,k,l,jj,kk)
4872 implicit real*8 (a-h,o-z)
4873 include 'DIMENSIONS'
4874 include 'COMMON.IOUNITS'
4875 include 'COMMON.DERIV'
4876 include 'COMMON.INTERACT'
4877 include 'COMMON.CONTACTS'
4878 double precision gx(3),gx1(3)
4883 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4884 C Calculate the multi-body contribution to energy.
4885 C Calculate multi-body contributions to the gradient.
4886 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4887 cd & k,l,(gacont(m,kk,k),m=1,3)
4889 gx(m) =ekl*gacont(m,jj,i)
4890 gx1(m)=eij*gacont(m,kk,k)
4891 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4892 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4893 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4894 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4898 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4903 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4909 c------------------------------------------------------------------------------
4911 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4912 implicit real*8 (a-h,o-z)
4913 include 'DIMENSIONS'
4914 integer dimen1,dimen2,atom,indx
4915 double precision buffer(dimen1,dimen2)
4916 double precision zapas
4917 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4918 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
4919 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4920 num_kont=num_cont_hb(atom)
4924 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4927 buffer(i,indx+22)=facont_hb(i,atom)
4928 buffer(i,indx+23)=ees0p(i,atom)
4929 buffer(i,indx+24)=ees0m(i,atom)
4930 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4932 buffer(1,indx+26)=dfloat(num_kont)
4935 c------------------------------------------------------------------------------
4936 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4937 implicit real*8 (a-h,o-z)
4938 include 'DIMENSIONS'
4939 integer dimen1,dimen2,atom,indx
4940 double precision buffer(dimen1,dimen2)
4941 double precision zapas
4942 common /contacts_hb/ zapas(3,ntyp,maxres,7),
4943 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
4944 & ees0m(ntyp,maxres),
4945 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
4946 num_kont=buffer(1,indx+26)
4947 num_kont_old=num_cont_hb(atom)
4948 num_cont_hb(atom)=num_kont+num_kont_old
4953 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4956 facont_hb(ii,atom)=buffer(i,indx+22)
4957 ees0p(ii,atom)=buffer(i,indx+23)
4958 ees0m(ii,atom)=buffer(i,indx+24)
4959 jcont_hb(ii,atom)=buffer(i,indx+25)
4963 c------------------------------------------------------------------------------
4965 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4966 C This subroutine calculates multi-body contributions to hydrogen-bonding
4967 implicit real*8 (a-h,o-z)
4968 include 'DIMENSIONS'
4969 include 'DIMENSIONS.ZSCOPT'
4970 include 'COMMON.IOUNITS'
4972 include 'COMMON.INFO'
4974 include 'COMMON.FFIELD'
4975 include 'COMMON.DERIV'
4976 include 'COMMON.INTERACT'
4977 include 'COMMON.CONTACTS'
4979 parameter (max_cont=maxconts)
4980 parameter (max_dim=2*(8*3+2))
4981 parameter (msglen1=max_cont*max_dim*4)
4982 parameter (msglen2=2*msglen1)
4983 integer source,CorrelType,CorrelID,Error
4984 double precision buffer(max_cont,max_dim)
4986 double precision gx(3),gx1(3)
4989 C Set lprn=.true. for debugging
4994 if (fgProcs.le.1) goto 30
4996 write (iout,'(a)') 'Contact function values:'
4998 write (iout,'(2i3,50(1x,i2,f5.2))')
4999 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5000 & j=1,num_cont_hb(i))
5003 C Caution! Following code assumes that electrostatic interactions concerning
5004 C a given atom are split among at most two processors!
5014 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5017 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5018 if (MyRank.gt.0) then
5019 C Send correlation contributions to the preceding processor
5021 nn=num_cont_hb(iatel_s)
5022 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5023 cd write (iout,*) 'The BUFFER array:'
5025 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5027 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5029 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5030 C Clear the contacts of the atom passed to the neighboring processor
5031 nn=num_cont_hb(iatel_s+1)
5033 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5035 num_cont_hb(iatel_s)=0
5037 cd write (iout,*) 'Processor ',MyID,MyRank,
5038 cd & ' is sending correlation contribution to processor',MyID-1,
5039 cd & ' msglen=',msglen
5040 cd write (*,*) 'Processor ',MyID,MyRank,
5041 cd & ' is sending correlation contribution to processor',MyID-1,
5042 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5043 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5044 cd write (iout,*) 'Processor ',MyID,
5045 cd & ' has sent correlation contribution to processor',MyID-1,
5046 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5047 cd write (*,*) 'Processor ',MyID,
5048 cd & ' has sent correlation contribution to processor',MyID-1,
5049 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5051 endif ! (MyRank.gt.0)
5055 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5056 if (MyRank.lt.fgProcs-1) then
5057 C Receive correlation contributions from the next processor
5059 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5060 cd write (iout,*) 'Processor',MyID,
5061 cd & ' is receiving correlation contribution from processor',MyID+1,
5062 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5063 cd write (*,*) 'Processor',MyID,
5064 cd & ' is receiving correlation contribution from processor',MyID+1,
5065 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5067 do while (nbytes.le.0)
5068 call mp_probe(MyID+1,CorrelType,nbytes)
5070 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5071 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5072 cd write (iout,*) 'Processor',MyID,
5073 cd & ' has received correlation contribution from processor',MyID+1,
5074 cd & ' msglen=',msglen,' nbytes=',nbytes
5075 cd write (iout,*) 'The received BUFFER array:'
5077 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5079 if (msglen.eq.msglen1) then
5080 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5081 else if (msglen.eq.msglen2) then
5082 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5083 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5086 & 'ERROR!!!! message length changed while processing correlations.'
5088 & 'ERROR!!!! message length changed while processing correlations.'
5089 call mp_stopall(Error)
5090 endif ! msglen.eq.msglen1
5091 endif ! MyRank.lt.fgProcs-1
5098 write (iout,'(a)') 'Contact function values:'
5100 write (iout,'(2i3,50(1x,i2,f5.2))')
5101 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5102 & j=1,num_cont_hb(i))
5106 C Remove the loop below after debugging !!!
5113 C Calculate the local-electrostatic correlation terms
5114 do i=iatel_s,iatel_e+1
5116 num_conti=num_cont_hb(i)
5117 num_conti1=num_cont_hb(i+1)
5122 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5123 c & ' jj=',jj,' kk=',kk
5124 if (j1.eq.j+1 .or. j1.eq.j-1) then
5125 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5126 C The system gains extra energy.
5127 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5129 else if (j1.eq.j) then
5130 C Contacts I-J and I-(J+1) occur simultaneously.
5131 C The system loses extra energy.
5132 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5137 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5138 c & ' jj=',jj,' kk=',kk
5140 C Contacts I-J and (I+1)-J occur simultaneously.
5141 C The system loses extra energy.
5142 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5149 c------------------------------------------------------------------------------
5150 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5152 C This subroutine calculates multi-body contributions to hydrogen-bonding
5153 implicit real*8 (a-h,o-z)
5154 include 'DIMENSIONS'
5155 include 'DIMENSIONS.ZSCOPT'
5156 include 'COMMON.IOUNITS'
5158 include 'COMMON.INFO'
5160 include 'COMMON.FFIELD'
5161 include 'COMMON.DERIV'
5162 include 'COMMON.INTERACT'
5163 include 'COMMON.CONTACTS'
5165 parameter (max_cont=maxconts)
5166 parameter (max_dim=2*(8*3+2))
5167 parameter (msglen1=max_cont*max_dim*4)
5168 parameter (msglen2=2*msglen1)
5169 integer source,CorrelType,CorrelID,Error
5170 double precision buffer(max_cont,max_dim)
5172 double precision gx(3),gx1(3)
5175 C Set lprn=.true. for debugging
5181 if (fgProcs.le.1) goto 30
5183 write (iout,'(a)') 'Contact function values:'
5185 write (iout,'(2i3,50(1x,i2,f5.2))')
5186 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5187 & j=1,num_cont_hb(i))
5190 C Caution! Following code assumes that electrostatic interactions concerning
5191 C a given atom are split among at most two processors!
5201 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5204 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5205 if (MyRank.gt.0) then
5206 C Send correlation contributions to the preceding processor
5208 nn=num_cont_hb(iatel_s)
5209 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5210 cd write (iout,*) 'The BUFFER array:'
5212 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5214 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5216 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5217 C Clear the contacts of the atom passed to the neighboring processor
5218 nn=num_cont_hb(iatel_s+1)
5220 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5222 num_cont_hb(iatel_s)=0
5224 cd write (iout,*) 'Processor ',MyID,MyRank,
5225 cd & ' is sending correlation contribution to processor',MyID-1,
5226 cd & ' msglen=',msglen
5227 cd write (*,*) 'Processor ',MyID,MyRank,
5228 cd & ' is sending correlation contribution to processor',MyID-1,
5229 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5230 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5231 cd write (iout,*) 'Processor ',MyID,
5232 cd & ' has sent correlation contribution to processor',MyID-1,
5233 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5234 cd write (*,*) 'Processor ',MyID,
5235 cd & ' has sent correlation contribution to processor',MyID-1,
5236 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5238 endif ! (MyRank.gt.0)
5242 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5243 if (MyRank.lt.fgProcs-1) then
5244 C Receive correlation contributions from the next processor
5246 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5247 cd write (iout,*) 'Processor',MyID,
5248 cd & ' is receiving correlation contribution from processor',MyID+1,
5249 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5250 cd write (*,*) 'Processor',MyID,
5251 cd & ' is receiving correlation contribution from processor',MyID+1,
5252 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5254 do while (nbytes.le.0)
5255 call mp_probe(MyID+1,CorrelType,nbytes)
5257 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5258 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5259 cd write (iout,*) 'Processor',MyID,
5260 cd & ' has received correlation contribution from processor',MyID+1,
5261 cd & ' msglen=',msglen,' nbytes=',nbytes
5262 cd write (iout,*) 'The received BUFFER array:'
5264 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5266 if (msglen.eq.msglen1) then
5267 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5268 else if (msglen.eq.msglen2) then
5269 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5270 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5273 & 'ERROR!!!! message length changed while processing correlations.'
5275 & 'ERROR!!!! message length changed while processing correlations.'
5276 call mp_stopall(Error)
5277 endif ! msglen.eq.msglen1
5278 endif ! MyRank.lt.fgProcs-1
5285 write (iout,'(a)') 'Contact function values:'
5287 write (iout,'(2i3,50(1x,i2,f5.2))')
5288 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5289 & j=1,num_cont_hb(i))
5295 C Remove the loop below after debugging !!!
5302 C Calculate the dipole-dipole interaction energies
5303 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5304 do i=iatel_s,iatel_e+1
5305 num_conti=num_cont_hb(i)
5312 C Calculate the local-electrostatic correlation terms
5313 do i=iatel_s,iatel_e+1
5315 num_conti=num_cont_hb(i)
5316 num_conti1=num_cont_hb(i+1)
5321 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5322 c & ' jj=',jj,' kk=',kk
5323 if (j1.eq.j+1 .or. j1.eq.j-1) then
5324 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5325 C The system gains extra energy.
5327 sqd1=dsqrt(d_cont(jj,i))
5328 sqd2=dsqrt(d_cont(kk,i1))
5329 sred_geom = sqd1*sqd2
5330 IF (sred_geom.lt.cutoff_corr) THEN
5331 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5333 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5334 c & ' jj=',jj,' kk=',kk
5335 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5336 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5338 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5339 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5342 cd write (iout,*) 'sred_geom=',sred_geom,
5343 cd & ' ekont=',ekont,' fprim=',fprimcont
5344 call calc_eello(i,j,i+1,j1,jj,kk)
5345 if (wcorr4.gt.0.0d0)
5346 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5347 if (wcorr5.gt.0.0d0)
5348 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5349 c print *,"wcorr5",ecorr5
5350 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5351 cd write(2,*)'ijkl',i,j,i+1,j1
5352 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5353 & .or. wturn6.eq.0.0d0))then
5354 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5355 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5356 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5357 cd & 'ecorr6=',ecorr6
5358 cd write (iout,'(4e15.5)') sred_geom,
5359 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5360 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5361 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5362 else if (wturn6.gt.0.0d0
5363 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5364 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5365 eturn6=eturn6+eello_turn6(i,jj,kk)
5366 cd write (2,*) 'multibody_eello:eturn6',eturn6
5370 else if (j1.eq.j) then
5371 C Contacts I-J and I-(J+1) occur simultaneously.
5372 C The system loses extra energy.
5373 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5378 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5379 c & ' jj=',jj,' kk=',kk
5381 C Contacts I-J and (I+1)-J occur simultaneously.
5382 C The system loses extra energy.
5383 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5390 c------------------------------------------------------------------------------
5391 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5392 implicit real*8 (a-h,o-z)
5393 include 'DIMENSIONS'
5394 include 'COMMON.IOUNITS'
5395 include 'COMMON.DERIV'
5396 include 'COMMON.INTERACT'
5397 include 'COMMON.CONTACTS'
5398 double precision gx(3),gx1(3)
5408 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5409 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5410 C Following 4 lines for diagnostics.
5415 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5417 c write (iout,*)'Contacts have occurred for peptide groups',
5418 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5419 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5420 C Calculate the multi-body contribution to energy.
5421 ecorr=ecorr+ekont*ees
5423 C Calculate multi-body contributions to the gradient.
5425 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5426 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5427 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5428 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5429 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5430 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5431 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5432 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5433 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5434 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5435 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5436 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5437 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5438 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5442 gradcorr(ll,m)=gradcorr(ll,m)+
5443 & ees*ekl*gacont_hbr(ll,jj,i)-
5444 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5445 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5450 gradcorr(ll,m)=gradcorr(ll,m)+
5451 & ees*eij*gacont_hbr(ll,kk,k)-
5452 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5453 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5460 C---------------------------------------------------------------------------
5461 subroutine dipole(i,j,jj)
5462 implicit real*8 (a-h,o-z)
5463 include 'DIMENSIONS'
5464 include 'DIMENSIONS.ZSCOPT'
5465 include 'COMMON.IOUNITS'
5466 include 'COMMON.CHAIN'
5467 include 'COMMON.FFIELD'
5468 include 'COMMON.DERIV'
5469 include 'COMMON.INTERACT'
5470 include 'COMMON.CONTACTS'
5471 include 'COMMON.TORSION'
5472 include 'COMMON.VAR'
5473 include 'COMMON.GEO'
5474 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5476 iti1 = itortyp(itype(i+1))
5477 if (j.lt.nres-1) then
5478 if (itype(j).le.ntyp) then
5479 itj1 = itortyp(itype(j+1))
5487 dipi(iii,1)=Ub2(iii,i)
5488 dipderi(iii)=Ub2der(iii,i)
5489 dipi(iii,2)=b1(iii,iti1)
5490 dipj(iii,1)=Ub2(iii,j)
5491 dipderj(iii)=Ub2der(iii,j)
5492 dipj(iii,2)=b1(iii,itj1)
5496 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5499 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5502 if (.not.calc_grad) return
5507 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5511 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5516 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5517 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5519 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5521 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5523 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5527 C---------------------------------------------------------------------------
5528 subroutine calc_eello(i,j,k,l,jj,kk)
5530 C This subroutine computes matrices and vectors needed to calculate
5531 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5533 implicit real*8 (a-h,o-z)
5534 include 'DIMENSIONS'
5535 include 'DIMENSIONS.ZSCOPT'
5536 include 'COMMON.IOUNITS'
5537 include 'COMMON.CHAIN'
5538 include 'COMMON.DERIV'
5539 include 'COMMON.INTERACT'
5540 include 'COMMON.CONTACTS'
5541 include 'COMMON.TORSION'
5542 include 'COMMON.VAR'
5543 include 'COMMON.GEO'
5544 include 'COMMON.FFIELD'
5545 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5546 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5549 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5550 cd & ' jj=',jj,' kk=',kk
5551 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5554 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5555 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5558 call transpose2(aa1(1,1),aa1t(1,1))
5559 call transpose2(aa2(1,1),aa2t(1,1))
5562 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5563 & aa1tder(1,1,lll,kkk))
5564 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5565 & aa2tder(1,1,lll,kkk))
5569 C parallel orientation of the two CA-CA-CA frames.
5570 if (i.gt.1 .and. itype(i).le.ntyp) then
5571 iti=itortyp(itype(i))
5575 itk1=itortyp(itype(k+1))
5576 itj=itortyp(itype(j))
5577 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5578 itl1=itortyp(itype(l+1))
5582 C A1 kernel(j+1) A2T
5584 cd write (iout,'(3f10.5,5x,3f10.5)')
5585 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5587 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5588 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5589 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5590 C Following matrices are needed only for 6-th order cumulants
5591 IF (wcorr6.gt.0.0d0) THEN
5592 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5593 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5594 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5595 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5596 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5597 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5598 & ADtEAderx(1,1,1,1,1,1))
5600 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5601 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5602 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5603 & ADtEA1derx(1,1,1,1,1,1))
5605 C End 6-th order cumulants
5608 cd write (2,*) 'In calc_eello6'
5610 cd write (2,*) 'iii=',iii
5612 cd write (2,*) 'kkk=',kkk
5614 cd write (2,'(3(2f10.5),5x)')
5615 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
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 A1T kernel(i+1) A2
5634 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5635 & a_chuj_der(1,1,1,1,kk,k),1,.false.,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) THEN
5639 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5640 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5641 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5642 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5643 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5644 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5645 & ADtEAderx(1,1,1,1,1,2))
5646 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5647 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5648 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5649 & ADtEA1derx(1,1,1,1,1,2))
5651 C End 6-th order cumulants
5652 call transpose2(EUgder(1,1,l),auxmat(1,1))
5653 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5654 call transpose2(EUg(1,1,l),auxmat(1,1))
5655 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5656 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5660 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5661 & EAEAderx(1,1,lll,kkk,iii,2))
5666 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5667 C They are needed only when the fifth- or the sixth-order cumulants are
5669 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5670 call transpose2(AEA(1,1,1),auxmat(1,1))
5671 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5672 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5673 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5674 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5675 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5676 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5677 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5678 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5679 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5680 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5681 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5682 call transpose2(AEA(1,1,2),auxmat(1,1))
5683 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5684 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5685 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5686 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5687 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5688 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5689 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5690 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5691 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5692 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5693 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5694 C Calculate the Cartesian derivatives of the vectors.
5698 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5699 call matvec2(auxmat(1,1),b1(1,iti),
5700 & AEAb1derx(1,lll,kkk,iii,1,1))
5701 call matvec2(auxmat(1,1),Ub2(1,i),
5702 & AEAb2derx(1,lll,kkk,iii,1,1))
5703 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5704 & AEAb1derx(1,lll,kkk,iii,2,1))
5705 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5706 & AEAb2derx(1,lll,kkk,iii,2,1))
5707 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5708 call matvec2(auxmat(1,1),b1(1,itj),
5709 & AEAb1derx(1,lll,kkk,iii,1,2))
5710 call matvec2(auxmat(1,1),Ub2(1,j),
5711 & AEAb2derx(1,lll,kkk,iii,1,2))
5712 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5713 & AEAb1derx(1,lll,kkk,iii,2,2))
5714 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5715 & AEAb2derx(1,lll,kkk,iii,2,2))
5722 C Antiparallel orientation of the two CA-CA-CA frames.
5723 if (i.gt.1 .and. itype(i).le.ntyp) then
5724 iti=itortyp(itype(i))
5728 itk1=itortyp(itype(k+1))
5729 itl=itortyp(itype(l))
5730 itj=itortyp(itype(j))
5731 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5732 itj1=itortyp(itype(j+1))
5736 C A2 kernel(j-1)T A1T
5737 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5738 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5739 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5740 C Following matrices are needed only for 6-th order cumulants
5741 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5742 & j.eq.i+4 .and. l.eq.i+3)) THEN
5743 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5744 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5745 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5746 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5747 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5748 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5749 & ADtEAderx(1,1,1,1,1,1))
5750 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5751 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5752 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5753 & ADtEA1derx(1,1,1,1,1,1))
5755 C End 6-th order cumulants
5756 call transpose2(EUgder(1,1,k),auxmat(1,1))
5757 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5758 call transpose2(EUg(1,1,k),auxmat(1,1))
5759 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5760 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5764 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5765 & EAEAderx(1,1,lll,kkk,iii,1))
5769 C A2T kernel(i+1)T A1
5770 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5771 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5772 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5773 C Following matrices are needed only for 6-th order cumulants
5774 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5775 & j.eq.i+4 .and. l.eq.i+3)) THEN
5776 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5777 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5778 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5779 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5780 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5781 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5782 & ADtEAderx(1,1,1,1,1,2))
5783 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5784 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5785 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5786 & ADtEA1derx(1,1,1,1,1,2))
5788 C End 6-th order cumulants
5789 call transpose2(EUgder(1,1,j),auxmat(1,1))
5790 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5791 call transpose2(EUg(1,1,j),auxmat(1,1))
5792 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5793 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5797 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5798 & EAEAderx(1,1,lll,kkk,iii,2))
5803 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5804 C They are needed only when the fifth- or the sixth-order cumulants are
5806 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5807 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5808 call transpose2(AEA(1,1,1),auxmat(1,1))
5809 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5810 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5811 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5812 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5813 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5814 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5815 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5816 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5817 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5818 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5819 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5820 call transpose2(AEA(1,1,2),auxmat(1,1))
5821 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5822 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5823 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5824 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5825 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5826 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5827 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5828 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5829 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5830 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5831 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5832 C Calculate the Cartesian derivatives of the vectors.
5836 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5837 call matvec2(auxmat(1,1),b1(1,iti),
5838 & AEAb1derx(1,lll,kkk,iii,1,1))
5839 call matvec2(auxmat(1,1),Ub2(1,i),
5840 & AEAb2derx(1,lll,kkk,iii,1,1))
5841 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5842 & AEAb1derx(1,lll,kkk,iii,2,1))
5843 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5844 & AEAb2derx(1,lll,kkk,iii,2,1))
5845 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5846 call matvec2(auxmat(1,1),b1(1,itl),
5847 & AEAb1derx(1,lll,kkk,iii,1,2))
5848 call matvec2(auxmat(1,1),Ub2(1,l),
5849 & AEAb2derx(1,lll,kkk,iii,1,2))
5850 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5851 & AEAb1derx(1,lll,kkk,iii,2,2))
5852 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5853 & AEAb2derx(1,lll,kkk,iii,2,2))
5862 C---------------------------------------------------------------------------
5863 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5864 & KK,KKderg,AKA,AKAderg,AKAderx)
5868 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5869 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5870 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5875 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5877 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5880 cd if (lprn) write (2,*) 'In kernel'
5882 cd if (lprn) write (2,*) 'kkk=',kkk
5884 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5885 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5887 cd write (2,*) 'lll=',lll
5888 cd write (2,*) 'iii=1'
5890 cd write (2,'(3(2f10.5),5x)')
5891 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5894 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5895 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5897 cd write (2,*) 'lll=',lll
5898 cd write (2,*) 'iii=2'
5900 cd write (2,'(3(2f10.5),5x)')
5901 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5908 C---------------------------------------------------------------------------
5909 double precision function eello4(i,j,k,l,jj,kk)
5910 implicit real*8 (a-h,o-z)
5911 include 'DIMENSIONS'
5912 include 'DIMENSIONS.ZSCOPT'
5913 include 'COMMON.IOUNITS'
5914 include 'COMMON.CHAIN'
5915 include 'COMMON.DERIV'
5916 include 'COMMON.INTERACT'
5917 include 'COMMON.CONTACTS'
5918 include 'COMMON.TORSION'
5919 include 'COMMON.VAR'
5920 include 'COMMON.GEO'
5921 double precision pizda(2,2),ggg1(3),ggg2(3)
5922 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5926 cd print *,'eello4:',i,j,k,l,jj,kk
5927 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5928 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5929 cold eij=facont_hb(jj,i)
5930 cold ekl=facont_hb(kk,k)
5932 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5934 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5935 gcorr_loc(k-1)=gcorr_loc(k-1)
5936 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5938 gcorr_loc(l-1)=gcorr_loc(l-1)
5939 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5941 gcorr_loc(j-1)=gcorr_loc(j-1)
5942 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5947 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5948 & -EAEAderx(2,2,lll,kkk,iii,1)
5949 cd derx(lll,kkk,iii)=0.0d0
5953 cd gcorr_loc(l-1)=0.0d0
5954 cd gcorr_loc(j-1)=0.0d0
5955 cd gcorr_loc(k-1)=0.0d0
5957 cd write (iout,*)'Contacts have occurred for peptide groups',
5958 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5959 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5960 if (j.lt.nres-1) then
5967 if (l.lt.nres-1) then
5975 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5976 ggg1(ll)=eel4*g_contij(ll,1)
5977 ggg2(ll)=eel4*g_contij(ll,2)
5978 ghalf=0.5d0*ggg1(ll)
5980 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5981 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5982 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5983 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5984 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5985 ghalf=0.5d0*ggg2(ll)
5987 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5988 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5989 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5990 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5995 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5996 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6001 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6002 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6008 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6013 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6017 cd write (2,*) iii,gcorr_loc(iii)
6021 cd write (2,*) 'ekont',ekont
6022 cd write (iout,*) 'eello4',ekont*eel4
6025 C---------------------------------------------------------------------------
6026 double precision function eello5(i,j,k,l,jj,kk)
6027 implicit real*8 (a-h,o-z)
6028 include 'DIMENSIONS'
6029 include 'DIMENSIONS.ZSCOPT'
6030 include 'COMMON.IOUNITS'
6031 include 'COMMON.CHAIN'
6032 include 'COMMON.DERIV'
6033 include 'COMMON.INTERACT'
6034 include 'COMMON.CONTACTS'
6035 include 'COMMON.TORSION'
6036 include 'COMMON.VAR'
6037 include 'COMMON.GEO'
6038 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6039 double precision ggg1(3),ggg2(3)
6040 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6045 C /l\ / \ \ / \ / \ / C
6046 C / \ / \ \ / \ / \ / C
6047 C j| o |l1 | o | o| o | | o |o C
6048 C \ |/k\| |/ \| / |/ \| |/ \| C
6049 C \i/ \ / \ / / \ / \ C
6051 C (I) (II) (III) (IV) C
6053 C eello5_1 eello5_2 eello5_3 eello5_4 C
6055 C Antiparallel chains C
6058 C /j\ / \ \ / \ / \ / C
6059 C / \ / \ \ / \ / \ / C
6060 C j1| o |l | o | o| o | | o |o C
6061 C \ |/k\| |/ \| / |/ \| |/ \| C
6062 C \i/ \ / \ / / \ / \ C
6064 C (I) (II) (III) (IV) C
6066 C eello5_1 eello5_2 eello5_3 eello5_4 C
6068 C o denotes a local interaction, vertical lines an electrostatic interaction. C
6070 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6071 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6076 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
6078 itk=itortyp(itype(k))
6079 itl=itortyp(itype(l))
6080 itj=itortyp(itype(j))
6085 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6086 cd & eel5_3_num,eel5_4_num)
6090 derx(lll,kkk,iii)=0.0d0
6094 cd eij=facont_hb(jj,i)
6095 cd ekl=facont_hb(kk,k)
6097 cd write (iout,*)'Contacts have occurred for peptide groups',
6098 cd & i,j,' fcont:',eij,' eij',' and ',k,l
6100 C Contribution from the graph I.
6101 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6102 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6103 call transpose2(EUg(1,1,k),auxmat(1,1))
6104 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6105 vv(1)=pizda(1,1)-pizda(2,2)
6106 vv(2)=pizda(1,2)+pizda(2,1)
6107 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6108 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6110 C Explicit gradient in virtual-dihedral angles.
6111 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6112 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6113 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6114 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6115 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6116 vv(1)=pizda(1,1)-pizda(2,2)
6117 vv(2)=pizda(1,2)+pizda(2,1)
6118 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6119 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6120 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6121 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6122 vv(1)=pizda(1,1)-pizda(2,2)
6123 vv(2)=pizda(1,2)+pizda(2,1)
6125 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6126 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6127 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6129 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6130 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6131 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6133 C Cartesian gradient
6137 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6139 vv(1)=pizda(1,1)-pizda(2,2)
6140 vv(2)=pizda(1,2)+pizda(2,1)
6141 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6142 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6143 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6150 C Contribution from graph II
6151 call transpose2(EE(1,1,itk),auxmat(1,1))
6152 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6153 vv(1)=pizda(1,1)+pizda(2,2)
6154 vv(2)=pizda(2,1)-pizda(1,2)
6155 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6156 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6158 C Explicit gradient in virtual-dihedral angles.
6159 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6160 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6161 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6162 vv(1)=pizda(1,1)+pizda(2,2)
6163 vv(2)=pizda(2,1)-pizda(1,2)
6165 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6166 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6167 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6169 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6170 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6171 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6173 C Cartesian gradient
6177 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6179 vv(1)=pizda(1,1)+pizda(2,2)
6180 vv(2)=pizda(2,1)-pizda(1,2)
6181 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6182 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6183 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6192 C Parallel orientation
6193 C Contribution from graph III
6194 call transpose2(EUg(1,1,l),auxmat(1,1))
6195 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6196 vv(1)=pizda(1,1)-pizda(2,2)
6197 vv(2)=pizda(1,2)+pizda(2,1)
6198 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6199 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6201 C Explicit gradient in virtual-dihedral angles.
6202 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6203 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6204 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6205 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6206 vv(1)=pizda(1,1)-pizda(2,2)
6207 vv(2)=pizda(1,2)+pizda(2,1)
6208 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6209 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6210 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6211 call transpose2(EUgder(1,1,l),auxmat1(1,1))
6212 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6213 vv(1)=pizda(1,1)-pizda(2,2)
6214 vv(2)=pizda(1,2)+pizda(2,1)
6215 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6216 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6217 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6218 C Cartesian gradient
6222 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6224 vv(1)=pizda(1,1)-pizda(2,2)
6225 vv(2)=pizda(1,2)+pizda(2,1)
6226 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6227 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6228 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6234 C Contribution from graph IV
6236 call transpose2(EE(1,1,itl),auxmat(1,1))
6237 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6238 vv(1)=pizda(1,1)+pizda(2,2)
6239 vv(2)=pizda(2,1)-pizda(1,2)
6240 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6241 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6243 C Explicit gradient in virtual-dihedral angles.
6244 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6245 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6246 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6247 vv(1)=pizda(1,1)+pizda(2,2)
6248 vv(2)=pizda(2,1)-pizda(1,2)
6249 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6250 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6251 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6252 C Cartesian gradient
6256 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6258 vv(1)=pizda(1,1)+pizda(2,2)
6259 vv(2)=pizda(2,1)-pizda(1,2)
6260 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6261 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6262 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6268 C Antiparallel orientation
6269 C Contribution from graph III
6271 call transpose2(EUg(1,1,j),auxmat(1,1))
6272 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6273 vv(1)=pizda(1,1)-pizda(2,2)
6274 vv(2)=pizda(1,2)+pizda(2,1)
6275 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6276 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6278 C Explicit gradient in virtual-dihedral angles.
6279 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6280 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6281 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6282 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6283 vv(1)=pizda(1,1)-pizda(2,2)
6284 vv(2)=pizda(1,2)+pizda(2,1)
6285 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6286 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6287 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6288 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6289 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6290 vv(1)=pizda(1,1)-pizda(2,2)
6291 vv(2)=pizda(1,2)+pizda(2,1)
6292 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6293 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6294 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6295 C Cartesian gradient
6299 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6301 vv(1)=pizda(1,1)-pizda(2,2)
6302 vv(2)=pizda(1,2)+pizda(2,1)
6303 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6304 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6305 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6311 C Contribution from graph IV
6313 call transpose2(EE(1,1,itj),auxmat(1,1))
6314 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6315 vv(1)=pizda(1,1)+pizda(2,2)
6316 vv(2)=pizda(2,1)-pizda(1,2)
6317 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6318 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6320 C Explicit gradient in virtual-dihedral angles.
6321 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6322 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6323 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6324 vv(1)=pizda(1,1)+pizda(2,2)
6325 vv(2)=pizda(2,1)-pizda(1,2)
6326 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6327 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6328 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6329 C Cartesian gradient
6333 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6335 vv(1)=pizda(1,1)+pizda(2,2)
6336 vv(2)=pizda(2,1)-pizda(1,2)
6337 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6338 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6339 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6346 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6347 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6348 cd write (2,*) 'ijkl',i,j,k,l
6349 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6350 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6352 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6353 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6354 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6355 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6357 if (j.lt.nres-1) then
6364 if (l.lt.nres-1) then
6374 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6376 ggg1(ll)=eel5*g_contij(ll,1)
6377 ggg2(ll)=eel5*g_contij(ll,2)
6378 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6379 ghalf=0.5d0*ggg1(ll)
6381 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6382 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6383 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6384 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6385 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6386 ghalf=0.5d0*ggg2(ll)
6388 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6389 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6390 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6391 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6396 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6397 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6402 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6403 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6409 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6414 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6418 cd write (2,*) iii,g_corr5_loc(iii)
6422 cd write (2,*) 'ekont',ekont
6423 cd write (iout,*) 'eello5',ekont*eel5
6426 c--------------------------------------------------------------------------
6427 double precision function eello6(i,j,k,l,jj,kk)
6428 implicit real*8 (a-h,o-z)
6429 include 'DIMENSIONS'
6430 include 'DIMENSIONS.ZSCOPT'
6431 include 'COMMON.IOUNITS'
6432 include 'COMMON.CHAIN'
6433 include 'COMMON.DERIV'
6434 include 'COMMON.INTERACT'
6435 include 'COMMON.CONTACTS'
6436 include 'COMMON.TORSION'
6437 include 'COMMON.VAR'
6438 include 'COMMON.GEO'
6439 include 'COMMON.FFIELD'
6440 double precision ggg1(3),ggg2(3)
6441 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6446 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6454 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6455 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6459 derx(lll,kkk,iii)=0.0d0
6463 cd eij=facont_hb(jj,i)
6464 cd ekl=facont_hb(kk,k)
6470 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6471 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6472 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6473 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6474 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6475 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6477 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6478 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6479 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6480 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6481 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6482 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6486 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6488 C If turn contributions are considered, they will be handled separately.
6489 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6490 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6491 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6492 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6493 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6494 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6495 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6498 if (j.lt.nres-1) then
6505 if (l.lt.nres-1) then
6513 ggg1(ll)=eel6*g_contij(ll,1)
6514 ggg2(ll)=eel6*g_contij(ll,2)
6515 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6516 ghalf=0.5d0*ggg1(ll)
6518 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6519 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6520 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6521 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6522 ghalf=0.5d0*ggg2(ll)
6523 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6525 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6526 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6527 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6528 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6533 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6534 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6539 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6540 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6546 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6551 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6555 cd write (2,*) iii,g_corr6_loc(iii)
6559 cd write (2,*) 'ekont',ekont
6560 cd write (iout,*) 'eello6',ekont*eel6
6563 c--------------------------------------------------------------------------
6564 double precision function eello6_graph1(i,j,k,l,imat,swap)
6565 implicit real*8 (a-h,o-z)
6566 include 'DIMENSIONS'
6567 include 'DIMENSIONS.ZSCOPT'
6568 include 'COMMON.IOUNITS'
6569 include 'COMMON.CHAIN'
6570 include 'COMMON.DERIV'
6571 include 'COMMON.INTERACT'
6572 include 'COMMON.CONTACTS'
6573 include 'COMMON.TORSION'
6574 include 'COMMON.VAR'
6575 include 'COMMON.GEO'
6576 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6580 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6582 C Parallel Antiparallel C
6588 C \ j|/k\| / \ |/k\|l / C
6593 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6594 itk=itortyp(itype(k))
6595 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6596 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6597 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6598 call transpose2(EUgC(1,1,k),auxmat(1,1))
6599 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6600 vv1(1)=pizda1(1,1)-pizda1(2,2)
6601 vv1(2)=pizda1(1,2)+pizda1(2,1)
6602 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6603 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6604 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6605 s5=scalar2(vv(1),Dtobr2(1,i))
6606 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6607 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6608 if (.not. calc_grad) return
6609 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6610 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6611 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6612 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6613 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6614 & +scalar2(vv(1),Dtobr2der(1,i)))
6615 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6616 vv1(1)=pizda1(1,1)-pizda1(2,2)
6617 vv1(2)=pizda1(1,2)+pizda1(2,1)
6618 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6619 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6621 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6622 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6623 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6624 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6625 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6627 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6628 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6629 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6630 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6631 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6633 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6634 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6635 vv1(1)=pizda1(1,1)-pizda1(2,2)
6636 vv1(2)=pizda1(1,2)+pizda1(2,1)
6637 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6638 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6639 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6640 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6649 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6650 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6651 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6652 call transpose2(EUgC(1,1,k),auxmat(1,1))
6653 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6655 vv1(1)=pizda1(1,1)-pizda1(2,2)
6656 vv1(2)=pizda1(1,2)+pizda1(2,1)
6657 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6658 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6659 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6660 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6661 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6662 s5=scalar2(vv(1),Dtobr2(1,i))
6663 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6669 c----------------------------------------------------------------------------
6670 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6671 implicit real*8 (a-h,o-z)
6672 include 'DIMENSIONS'
6673 include 'DIMENSIONS.ZSCOPT'
6674 include 'COMMON.IOUNITS'
6675 include 'COMMON.CHAIN'
6676 include 'COMMON.DERIV'
6677 include 'COMMON.INTERACT'
6678 include 'COMMON.CONTACTS'
6679 include 'COMMON.TORSION'
6680 include 'COMMON.VAR'
6681 include 'COMMON.GEO'
6683 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6684 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6687 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6689 C Parallel Antiparallel C
6695 C \ j|/k\| \ |/k\|l C
6700 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6701 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6702 C AL 7/4/01 s1 would occur in the sixth-order moment,
6703 C but not in a cluster cumulant
6705 s1=dip(1,jj,i)*dip(1,kk,k)
6707 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6708 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6709 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6710 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6711 call transpose2(EUg(1,1,k),auxmat(1,1))
6712 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6713 vv(1)=pizda(1,1)-pizda(2,2)
6714 vv(2)=pizda(1,2)+pizda(2,1)
6715 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6716 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6718 eello6_graph2=-(s1+s2+s3+s4)
6720 eello6_graph2=-(s2+s3+s4)
6723 if (.not. calc_grad) return
6724 C Derivatives in gamma(i-1)
6727 s1=dipderg(1,jj,i)*dip(1,kk,k)
6729 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6730 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6731 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6732 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6734 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6736 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6738 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6740 C Derivatives in gamma(k-1)
6742 s1=dip(1,jj,i)*dipderg(1,kk,k)
6744 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6745 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6746 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6747 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6748 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6749 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6750 vv(1)=pizda(1,1)-pizda(2,2)
6751 vv(2)=pizda(1,2)+pizda(2,1)
6752 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6754 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6756 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6758 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6759 C Derivatives in gamma(j-1) or gamma(l-1)
6762 s1=dipderg(3,jj,i)*dip(1,kk,k)
6764 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6765 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6766 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6767 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6768 vv(1)=pizda(1,1)-pizda(2,2)
6769 vv(2)=pizda(1,2)+pizda(2,1)
6770 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6773 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6775 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6778 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6779 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6781 C Derivatives in gamma(l-1) or gamma(j-1)
6784 s1=dip(1,jj,i)*dipderg(3,kk,k)
6786 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6787 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6788 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6789 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6790 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6791 vv(1)=pizda(1,1)-pizda(2,2)
6792 vv(2)=pizda(1,2)+pizda(2,1)
6793 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6796 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6798 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6801 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6802 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6804 C Cartesian derivatives.
6806 write (2,*) 'In eello6_graph2'
6808 write (2,*) 'iii=',iii
6810 write (2,*) 'kkk=',kkk
6812 write (2,'(3(2f10.5),5x)')
6813 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6823 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6825 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6828 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6830 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6831 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6833 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6834 call transpose2(EUg(1,1,k),auxmat(1,1))
6835 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6837 vv(1)=pizda(1,1)-pizda(2,2)
6838 vv(2)=pizda(1,2)+pizda(2,1)
6839 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6840 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6842 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6844 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6847 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6849 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6856 c----------------------------------------------------------------------------
6857 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6858 implicit real*8 (a-h,o-z)
6859 include 'DIMENSIONS'
6860 include 'DIMENSIONS.ZSCOPT'
6861 include 'COMMON.IOUNITS'
6862 include 'COMMON.CHAIN'
6863 include 'COMMON.DERIV'
6864 include 'COMMON.INTERACT'
6865 include 'COMMON.CONTACTS'
6866 include 'COMMON.TORSION'
6867 include 'COMMON.VAR'
6868 include 'COMMON.GEO'
6869 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6871 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6873 C Parallel Antiparallel C
6879 C j|/k\| / |/k\|l / C
6884 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6886 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6887 C energy moment and not to the cluster cumulant.
6888 iti=itortyp(itype(i))
6889 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6890 itj1=itortyp(itype(j+1))
6894 itk=itortyp(itype(k))
6895 itk1=itortyp(itype(k+1))
6896 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6897 itl1=itortyp(itype(l+1))
6902 s1=dip(4,jj,i)*dip(4,kk,k)
6904 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6905 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6906 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6907 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6908 call transpose2(EE(1,1,itk),auxmat(1,1))
6909 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6910 vv(1)=pizda(1,1)+pizda(2,2)
6911 vv(2)=pizda(2,1)-pizda(1,2)
6912 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6913 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6915 eello6_graph3=-(s1+s2+s3+s4)
6917 eello6_graph3=-(s2+s3+s4)
6920 if (.not. calc_grad) return
6921 C Derivatives in gamma(k-1)
6922 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6923 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6924 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6925 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6926 C Derivatives in gamma(l-1)
6927 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6928 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6929 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6930 vv(1)=pizda(1,1)+pizda(2,2)
6931 vv(2)=pizda(2,1)-pizda(1,2)
6932 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6933 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6934 C Cartesian derivatives.
6940 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6942 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6945 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6947 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6948 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6950 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6951 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6953 vv(1)=pizda(1,1)+pizda(2,2)
6954 vv(2)=pizda(2,1)-pizda(1,2)
6955 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6957 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6959 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6962 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6964 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6966 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6972 c----------------------------------------------------------------------------
6973 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6974 implicit real*8 (a-h,o-z)
6975 include 'DIMENSIONS'
6976 include 'DIMENSIONS.ZSCOPT'
6977 include 'COMMON.IOUNITS'
6978 include 'COMMON.CHAIN'
6979 include 'COMMON.DERIV'
6980 include 'COMMON.INTERACT'
6981 include 'COMMON.CONTACTS'
6982 include 'COMMON.TORSION'
6983 include 'COMMON.VAR'
6984 include 'COMMON.GEO'
6985 include 'COMMON.FFIELD'
6986 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6987 & auxvec1(2),auxmat1(2,2)
6989 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6991 C Parallel Antiparallel C
6997 C \ j|/k\| \ |/k\|l C
7002 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7004 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7005 C energy moment and not to the cluster cumulant.
7006 cd write (2,*) 'eello_graph4: wturn6',wturn6
7007 iti=itortyp(itype(i))
7008 itj=itortyp(itype(j))
7009 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7010 itj1=itortyp(itype(j+1))
7014 itk=itortyp(itype(k))
7015 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
7016 itk1=itortyp(itype(k+1))
7020 itl=itortyp(itype(l))
7021 if (l.lt.nres-1) then
7022 itl1=itortyp(itype(l+1))
7026 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7027 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7028 cd & ' itl',itl,' itl1',itl1
7031 s1=dip(3,jj,i)*dip(3,kk,k)
7033 s1=dip(2,jj,j)*dip(2,kk,l)
7036 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7037 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7039 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7040 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7042 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7043 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7045 call transpose2(EUg(1,1,k),auxmat(1,1))
7046 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7047 vv(1)=pizda(1,1)-pizda(2,2)
7048 vv(2)=pizda(2,1)+pizda(1,2)
7049 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7050 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7052 eello6_graph4=-(s1+s2+s3+s4)
7054 eello6_graph4=-(s2+s3+s4)
7056 if (.not. calc_grad) return
7057 C Derivatives in gamma(i-1)
7061 s1=dipderg(2,jj,i)*dip(3,kk,k)
7063 s1=dipderg(4,jj,j)*dip(2,kk,l)
7066 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7068 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7069 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7071 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7072 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7074 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7075 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7076 cd write (2,*) 'turn6 derivatives'
7078 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7080 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7084 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7086 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7090 C Derivatives in gamma(k-1)
7093 s1=dip(3,jj,i)*dipderg(2,kk,k)
7095 s1=dip(2,jj,j)*dipderg(4,kk,l)
7098 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7099 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7101 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7102 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7104 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7105 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7107 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7108 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7109 vv(1)=pizda(1,1)-pizda(2,2)
7110 vv(2)=pizda(2,1)+pizda(1,2)
7111 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7112 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7114 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7116 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7120 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7122 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7125 C Derivatives in gamma(j-1) or gamma(l-1)
7126 if (l.eq.j+1 .and. l.gt.1) then
7127 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7128 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7129 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7130 vv(1)=pizda(1,1)-pizda(2,2)
7131 vv(2)=pizda(2,1)+pizda(1,2)
7132 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7133 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7134 else if (j.gt.1) then
7135 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7136 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7137 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7138 vv(1)=pizda(1,1)-pizda(2,2)
7139 vv(2)=pizda(2,1)+pizda(1,2)
7140 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7141 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7142 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7144 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7147 C Cartesian derivatives.
7154 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7156 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7160 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7162 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7166 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7168 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7170 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7171 & b1(1,itj1),auxvec(1))
7172 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7174 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7175 & b1(1,itl1),auxvec(1))
7176 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7178 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7180 vv(1)=pizda(1,1)-pizda(2,2)
7181 vv(2)=pizda(2,1)+pizda(1,2)
7182 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7184 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7186 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7189 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7192 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7195 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7197 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7199 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7203 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7205 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7208 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7210 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7218 c----------------------------------------------------------------------------
7219 double precision function eello_turn6(i,jj,kk)
7220 implicit real*8 (a-h,o-z)
7221 include 'DIMENSIONS'
7222 include 'DIMENSIONS.ZSCOPT'
7223 include 'COMMON.IOUNITS'
7224 include 'COMMON.CHAIN'
7225 include 'COMMON.DERIV'
7226 include 'COMMON.INTERACT'
7227 include 'COMMON.CONTACTS'
7228 include 'COMMON.TORSION'
7229 include 'COMMON.VAR'
7230 include 'COMMON.GEO'
7231 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7232 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7234 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7235 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7236 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7237 C the respective energy moment and not to the cluster cumulant.
7242 iti=itortyp(itype(i))
7243 itk=itortyp(itype(k))
7244 itk1=itortyp(itype(k+1))
7245 itl=itortyp(itype(l))
7246 itj=itortyp(itype(j))
7247 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7248 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7249 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7254 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7256 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7260 derx_turn(lll,kkk,iii)=0.0d0
7267 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7269 cd write (2,*) 'eello6_5',eello6_5
7271 call transpose2(AEA(1,1,1),auxmat(1,1))
7272 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7273 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7274 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7278 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7279 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7280 s2 = scalar2(b1(1,itk),vtemp1(1))
7282 call transpose2(AEA(1,1,2),atemp(1,1))
7283 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7284 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7285 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7289 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7290 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7291 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7293 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7294 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7295 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7296 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7297 ss13 = scalar2(b1(1,itk),vtemp4(1))
7298 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7302 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7308 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7310 C Derivatives in gamma(i+2)
7312 call transpose2(AEA(1,1,1),auxmatd(1,1))
7313 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7314 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7315 call transpose2(AEAderg(1,1,2),atempd(1,1))
7316 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7317 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7321 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7322 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7323 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7329 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7330 C Derivatives in gamma(i+3)
7332 call transpose2(AEA(1,1,1),auxmatd(1,1))
7333 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7334 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7335 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7339 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7340 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7341 s2d = scalar2(b1(1,itk),vtemp1d(1))
7343 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7344 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7346 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7348 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7349 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7350 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7360 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7361 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7363 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7364 & -0.5d0*ekont*(s2d+s12d)
7366 C Derivatives in gamma(i+4)
7367 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7368 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7369 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7371 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7372 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7373 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7383 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7385 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7387 C Derivatives in gamma(i+5)
7389 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7390 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7391 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7395 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7396 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7397 s2d = scalar2(b1(1,itk),vtemp1d(1))
7399 call transpose2(AEA(1,1,2),atempd(1,1))
7400 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7401 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7405 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7406 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7408 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7409 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7410 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7420 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7421 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7423 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7424 & -0.5d0*ekont*(s2d+s12d)
7426 C Cartesian derivatives
7431 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7432 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7433 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7437 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7438 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7440 s2d = scalar2(b1(1,itk),vtemp1d(1))
7442 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7443 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7444 s8d = -(atempd(1,1)+atempd(2,2))*
7445 & scalar2(cc(1,1,itl),vtemp2(1))
7449 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7451 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7452 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7459 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7462 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7466 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7467 & - 0.5d0*(s8d+s12d)
7469 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7478 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7480 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7481 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7482 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7483 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7484 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7486 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7487 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7488 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7492 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7493 cd & 16*eel_turn6_num
7495 if (j.lt.nres-1) then
7502 if (l.lt.nres-1) then
7510 ggg1(ll)=eel_turn6*g_contij(ll,1)
7511 ggg2(ll)=eel_turn6*g_contij(ll,2)
7512 ghalf=0.5d0*ggg1(ll)
7514 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7515 & +ekont*derx_turn(ll,2,1)
7516 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7517 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7518 & +ekont*derx_turn(ll,4,1)
7519 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7520 ghalf=0.5d0*ggg2(ll)
7522 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7523 & +ekont*derx_turn(ll,2,2)
7524 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7525 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7526 & +ekont*derx_turn(ll,4,2)
7527 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7532 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7537 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7543 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7548 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7552 cd write (2,*) iii,g_corr6_loc(iii)
7555 eello_turn6=ekont*eel_turn6
7556 cd write (2,*) 'ekont',ekont
7557 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7560 crc-------------------------------------------------
7561 SUBROUTINE MATVEC2(A1,V1,V2)
7562 implicit real*8 (a-h,o-z)
7563 include 'DIMENSIONS'
7564 DIMENSION A1(2,2),V1(2),V2(2)
7568 c 3 VI=VI+A1(I,K)*V1(K)
7572 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7573 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7578 C---------------------------------------
7579 SUBROUTINE MATMAT2(A1,A2,A3)
7580 implicit real*8 (a-h,o-z)
7581 include 'DIMENSIONS'
7582 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7583 c DIMENSION AI3(2,2)
7587 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7593 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7594 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7595 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7596 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7604 c-------------------------------------------------------------------------
7605 double precision function scalar2(u,v)
7607 double precision u(2),v(2)
7610 scalar2=u(1)*v(1)+u(2)*v(2)
7614 C-----------------------------------------------------------------------------
7616 subroutine transpose2(a,at)
7618 double precision a(2,2),at(2,2)
7625 c--------------------------------------------------------------------------
7626 subroutine transpose(n,a,at)
7629 double precision a(n,n),at(n,n)
7637 C---------------------------------------------------------------------------
7638 subroutine prodmat3(a1,a2,kk,transp,prod)
7641 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7643 crc double precision auxmat(2,2),prod_(2,2)
7646 crc call transpose2(kk(1,1),auxmat(1,1))
7647 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7648 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7650 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7651 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7652 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7653 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7654 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7655 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7656 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7657 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7660 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7661 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7663 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7664 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7665 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7666 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7667 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7668 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7669 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7670 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7673 c call transpose2(a2(1,1),a2t(1,1))
7676 crc print *,((prod_(i,j),i=1,2),j=1,2)
7677 crc print *,((prod(i,j),i=1,2),j=1,2)
7681 C-----------------------------------------------------------------------------
7682 double precision function scalar(u,v)
7684 double precision u(3),v(3)
7694 C-----------------------------------------------------------------------
7695 double precision function sscale(r)
7696 double precision r,gamm
7697 include "COMMON.SPLITELE"
7698 if(r.lt.r_cut-rlamb) then
7700 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7701 gamm=(r-(r_cut-rlamb))/rlamb
7702 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
7708 C-----------------------------------------------------------------------
7709 C-----------------------------------------------------------------------
7710 double precision function sscagrad(r)
7711 double precision r,gamm
7712 include "COMMON.SPLITELE"
7713 if(r.lt.r_cut-rlamb) then
7715 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
7716 gamm=(r-(r_cut-rlamb))/rlamb
7717 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
7723 C-----------------------------------------------------------------------