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.21) cycle
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.21) 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.21) cycle
550 C Calculate SC interaction energy.
553 do j=istart(i,iint),iend(i,iint)
555 if (itypj.eq.21) 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.21) cycle
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.21) 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.21) cycle
800 dxi=dc_norm(1,nres+i)
801 dyi=dc_norm(2,nres+i)
802 dzi=dc_norm(3,nres+i)
803 dsci_inv=vbld_inv(i+nres)
805 C Calculate SC interaction energy.
808 do j=istart(i,iint),iend(i,iint)
811 if (itypj.eq.21) cycle
812 dscj_inv=vbld_inv(j+nres)
813 sig0ij=sigma(itypi,itypj)
814 chi1=chi(itypi,itypj)
815 chi2=chi(itypj,itypi)
822 alf12=0.5D0*(alf1+alf2)
823 C For diagnostics only!!!
836 dxj=dc_norm(1,nres+j)
837 dyj=dc_norm(2,nres+j)
838 dzj=dc_norm(3,nres+j)
839 c write (iout,*) i,j,xj,yj,zj
840 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
842 C Calculate angle-dependent terms of energy and contributions to their
846 sig=sig0ij*dsqrt(sigsq)
847 rij_shift=1.0D0/rij-sig+sig0ij
848 C I hate to put IF's in the loops, but here don't have another choice!!!!
849 if (rij_shift.le.0.0D0) then
854 c---------------------------------------------------------------
855 rij_shift=1.0D0/rij_shift
857 e1=fac*fac*aa(itypi,itypj)
858 e2=fac*bb(itypi,itypj)
859 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
860 eps2der=evdwij*eps3rt
861 eps3der=evdwij*eps2rt
862 evdwij=evdwij*eps2rt*eps3rt
863 if (bb(itypi,itypj).gt.0) then
868 ij=icant(itypi,itypj)
869 aux=eps1*eps2rt**2*eps3rt**2
870 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
871 & /dabs(eps(itypi,itypj))
872 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
873 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
874 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
875 c & aux*e2/eps(itypi,itypj)
877 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
878 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
880 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
881 & restyp(itypi),i,restyp(itypj),j,
882 & epsi,sigm,chi1,chi2,chip1,chip2,
883 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
884 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
886 write (iout,*) "partial sum", evdw, evdw_t
890 C Calculate gradient components.
891 e1=e1*eps1*eps2rt**2*eps3rt**2
892 fac=-expon*(e1+evdwij)*rij_shift
895 C Calculate the radial part of the gradient
899 C Calculate angular part of the gradient.
907 C-----------------------------------------------------------------------------
908 subroutine egbv(evdw,evdw_t)
910 C This subroutine calculates the interaction energy of nonbonded side chains
911 C assuming the Gay-Berne-Vorobjev potential of interaction.
913 implicit real*8 (a-h,o-z)
915 include 'DIMENSIONS.ZSCOPT'
916 include "DIMENSIONS.COMPAR"
919 include 'COMMON.LOCAL'
920 include 'COMMON.CHAIN'
921 include 'COMMON.DERIV'
922 include 'COMMON.NAMES'
923 include 'COMMON.INTERACT'
924 include 'COMMON.ENEPS'
925 include 'COMMON.IOUNITS'
926 include 'COMMON.CALC'
933 eneps_temp(j,i)=0.0d0
938 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
941 c if (icall.gt.0) lprn=.true.
945 if (itypi.eq.21) cycle
950 dxi=dc_norm(1,nres+i)
951 dyi=dc_norm(2,nres+i)
952 dzi=dc_norm(3,nres+i)
953 dsci_inv=vbld_inv(i+nres)
955 C Calculate SC interaction energy.
958 do j=istart(i,iint),iend(i,iint)
961 if (itypj.eq.21) cycle
962 dscj_inv=vbld_inv(j+nres)
963 sig0ij=sigma(itypi,itypj)
965 chi1=chi(itypi,itypj)
966 chi2=chi(itypj,itypi)
973 alf12=0.5D0*(alf1+alf2)
974 C For diagnostics only!!!
987 dxj=dc_norm(1,nres+j)
988 dyj=dc_norm(2,nres+j)
989 dzj=dc_norm(3,nres+j)
990 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
992 C Calculate angle-dependent terms of energy and contributions to their
996 sig=sig0ij*dsqrt(sigsq)
997 rij_shift=1.0D0/rij-sig+r0ij
998 C I hate to put IF's in the loops, but here don't have another choice!!!!
999 if (rij_shift.le.0.0D0) then
1004 c---------------------------------------------------------------
1005 rij_shift=1.0D0/rij_shift
1006 fac=rij_shift**expon
1007 e1=fac*fac*aa(itypi,itypj)
1008 e2=fac*bb(itypi,itypj)
1009 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1010 eps2der=evdwij*eps3rt
1011 eps3der=evdwij*eps2rt
1012 fac_augm=rrij**expon
1013 e_augm=augm(itypi,itypj)*fac_augm
1014 evdwij=evdwij*eps2rt*eps3rt
1015 if (bb(itypi,itypj).gt.0.0d0) then
1016 evdw=evdw+evdwij+e_augm
1018 evdw_t=evdw_t+evdwij+e_augm
1020 ij=icant(itypi,itypj)
1021 aux=eps1*eps2rt**2*eps3rt**2
1022 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1023 & /dabs(eps(itypi,itypj))
1024 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1025 c eneps_temp(ij)=eneps_temp(ij)
1026 c & +(evdwij+e_augm)/eps(itypi,itypj)
1028 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1029 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1030 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1031 c & restyp(itypi),i,restyp(itypj),j,
1032 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1033 c & chi1,chi2,chip1,chip2,
1034 c & eps1,eps2rt**2,eps3rt**2,
1035 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1039 C Calculate gradient components.
1040 e1=e1*eps1*eps2rt**2*eps3rt**2
1041 fac=-expon*(e1+evdwij)*rij_shift
1043 fac=rij*fac-2*expon*rrij*e_augm
1044 C Calculate the radial part of the gradient
1048 C Calculate angular part of the gradient.
1056 C-----------------------------------------------------------------------------
1057 subroutine sc_angular
1058 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1059 C om12. Called by ebp, egb, and egbv.
1061 include 'COMMON.CALC'
1065 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1066 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1067 om12=dxi*dxj+dyi*dyj+dzi*dzj
1069 C Calculate eps1(om12) and its derivative in om12
1070 faceps1=1.0D0-om12*chiom12
1071 faceps1_inv=1.0D0/faceps1
1072 eps1=dsqrt(faceps1_inv)
1073 C Following variable is eps1*deps1/dom12
1074 eps1_om12=faceps1_inv*chiom12
1075 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1080 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1081 sigsq=1.0D0-facsig*faceps1_inv
1082 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1083 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1084 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1085 C Calculate eps2 and its derivatives in om1, om2, and om12.
1088 chipom12=chip12*om12
1089 facp=1.0D0-om12*chipom12
1091 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1092 C Following variable is the square root of eps2
1093 eps2rt=1.0D0-facp1*facp_inv
1094 C Following three variables are the derivatives of the square root of eps
1095 C in om1, om2, and om12.
1096 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1097 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1098 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1099 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1100 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1101 C Calculate whole angle-dependent part of epsilon and contributions
1102 C to its derivatives
1105 C----------------------------------------------------------------------------
1107 implicit real*8 (a-h,o-z)
1108 include 'DIMENSIONS'
1109 include 'DIMENSIONS.ZSCOPT'
1110 include 'COMMON.CHAIN'
1111 include 'COMMON.DERIV'
1112 include 'COMMON.CALC'
1113 double precision dcosom1(3),dcosom2(3)
1114 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1115 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1116 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1117 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1119 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1120 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1123 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1126 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1127 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1128 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1129 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1130 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1131 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1134 C Calculate the components of the gradient in DC and X
1138 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1143 c------------------------------------------------------------------------------
1144 subroutine vec_and_deriv
1145 implicit real*8 (a-h,o-z)
1146 include 'DIMENSIONS'
1147 include 'DIMENSIONS.ZSCOPT'
1148 include 'COMMON.IOUNITS'
1149 include 'COMMON.GEO'
1150 include 'COMMON.VAR'
1151 include 'COMMON.LOCAL'
1152 include 'COMMON.CHAIN'
1153 include 'COMMON.VECTORS'
1154 include 'COMMON.DERIV'
1155 include 'COMMON.INTERACT'
1156 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1157 C Compute the local reference systems. For reference system (i), the
1158 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1159 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1161 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1162 if (i.eq.nres-1) then
1163 C Case of the last full residue
1164 C Compute the Z-axis
1165 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1166 costh=dcos(pi-theta(nres))
1167 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1172 C Compute the derivatives of uz
1174 uzder(2,1,1)=-dc_norm(3,i-1)
1175 uzder(3,1,1)= dc_norm(2,i-1)
1176 uzder(1,2,1)= dc_norm(3,i-1)
1178 uzder(3,2,1)=-dc_norm(1,i-1)
1179 uzder(1,3,1)=-dc_norm(2,i-1)
1180 uzder(2,3,1)= dc_norm(1,i-1)
1183 uzder(2,1,2)= dc_norm(3,i)
1184 uzder(3,1,2)=-dc_norm(2,i)
1185 uzder(1,2,2)=-dc_norm(3,i)
1187 uzder(3,2,2)= dc_norm(1,i)
1188 uzder(1,3,2)= dc_norm(2,i)
1189 uzder(2,3,2)=-dc_norm(1,i)
1192 C Compute the Y-axis
1195 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1198 C Compute the derivatives of uy
1201 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1202 & -dc_norm(k,i)*dc_norm(j,i-1)
1203 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1205 uyder(j,j,1)=uyder(j,j,1)-costh
1206 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1211 uygrad(l,k,j,i)=uyder(l,k,j)
1212 uzgrad(l,k,j,i)=uzder(l,k,j)
1216 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1217 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1218 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1219 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1223 C Compute the Z-axis
1224 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1225 costh=dcos(pi-theta(i+2))
1226 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1231 C Compute the derivatives of uz
1233 uzder(2,1,1)=-dc_norm(3,i+1)
1234 uzder(3,1,1)= dc_norm(2,i+1)
1235 uzder(1,2,1)= dc_norm(3,i+1)
1237 uzder(3,2,1)=-dc_norm(1,i+1)
1238 uzder(1,3,1)=-dc_norm(2,i+1)
1239 uzder(2,3,1)= dc_norm(1,i+1)
1242 uzder(2,1,2)= dc_norm(3,i)
1243 uzder(3,1,2)=-dc_norm(2,i)
1244 uzder(1,2,2)=-dc_norm(3,i)
1246 uzder(3,2,2)= dc_norm(1,i)
1247 uzder(1,3,2)= dc_norm(2,i)
1248 uzder(2,3,2)=-dc_norm(1,i)
1251 C Compute the Y-axis
1254 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1257 C Compute the derivatives of uy
1260 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1261 & -dc_norm(k,i)*dc_norm(j,i+1)
1262 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1264 uyder(j,j,1)=uyder(j,j,1)-costh
1265 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1270 uygrad(l,k,j,i)=uyder(l,k,j)
1271 uzgrad(l,k,j,i)=uzder(l,k,j)
1275 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1276 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1277 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1278 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1284 vbld_inv_temp(1)=vbld_inv(i+1)
1285 if (i.lt.nres-1) then
1286 vbld_inv_temp(2)=vbld_inv(i+2)
1288 vbld_inv_temp(2)=vbld_inv(i)
1293 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1294 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1302 C-----------------------------------------------------------------------------
1303 subroutine vec_and_deriv_test
1304 implicit real*8 (a-h,o-z)
1305 include 'DIMENSIONS'
1306 include 'DIMENSIONS.ZSCOPT'
1307 include 'COMMON.IOUNITS'
1308 include 'COMMON.GEO'
1309 include 'COMMON.VAR'
1310 include 'COMMON.LOCAL'
1311 include 'COMMON.CHAIN'
1312 include 'COMMON.VECTORS'
1313 dimension uyder(3,3,2),uzder(3,3,2)
1314 C Compute the local reference systems. For reference system (i), the
1315 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1316 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1318 if (i.eq.nres-1) then
1319 C Case of the last full residue
1320 C Compute the Z-axis
1321 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1322 costh=dcos(pi-theta(nres))
1323 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1324 c write (iout,*) 'fac',fac,
1325 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1326 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1330 C Compute the derivatives of uz
1332 uzder(2,1,1)=-dc_norm(3,i-1)
1333 uzder(3,1,1)= dc_norm(2,i-1)
1334 uzder(1,2,1)= dc_norm(3,i-1)
1336 uzder(3,2,1)=-dc_norm(1,i-1)
1337 uzder(1,3,1)=-dc_norm(2,i-1)
1338 uzder(2,3,1)= dc_norm(1,i-1)
1341 uzder(2,1,2)= dc_norm(3,i)
1342 uzder(3,1,2)=-dc_norm(2,i)
1343 uzder(1,2,2)=-dc_norm(3,i)
1345 uzder(3,2,2)= dc_norm(1,i)
1346 uzder(1,3,2)= dc_norm(2,i)
1347 uzder(2,3,2)=-dc_norm(1,i)
1349 C Compute the Y-axis
1351 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1354 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1355 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1356 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1358 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1361 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1362 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1365 c write (iout,*) 'facy',facy,
1366 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1367 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1369 uy(k,i)=facy*uy(k,i)
1371 C Compute the derivatives of uy
1374 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1375 & -dc_norm(k,i)*dc_norm(j,i-1)
1376 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1378 c uyder(j,j,1)=uyder(j,j,1)-costh
1379 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1380 uyder(j,j,1)=uyder(j,j,1)
1381 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1382 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1388 uygrad(l,k,j,i)=uyder(l,k,j)
1389 uzgrad(l,k,j,i)=uzder(l,k,j)
1393 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1394 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1395 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1396 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1399 C Compute the Z-axis
1400 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1401 costh=dcos(pi-theta(i+2))
1402 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1403 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1407 C Compute the derivatives of uz
1409 uzder(2,1,1)=-dc_norm(3,i+1)
1410 uzder(3,1,1)= dc_norm(2,i+1)
1411 uzder(1,2,1)= dc_norm(3,i+1)
1413 uzder(3,2,1)=-dc_norm(1,i+1)
1414 uzder(1,3,1)=-dc_norm(2,i+1)
1415 uzder(2,3,1)= dc_norm(1,i+1)
1418 uzder(2,1,2)= dc_norm(3,i)
1419 uzder(3,1,2)=-dc_norm(2,i)
1420 uzder(1,2,2)=-dc_norm(3,i)
1422 uzder(3,2,2)= dc_norm(1,i)
1423 uzder(1,3,2)= dc_norm(2,i)
1424 uzder(2,3,2)=-dc_norm(1,i)
1426 C Compute the Y-axis
1428 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1429 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1430 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1432 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1435 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1436 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1439 c write (iout,*) 'facy',facy,
1440 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1441 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1443 uy(k,i)=facy*uy(k,i)
1445 C Compute the derivatives of uy
1448 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1449 & -dc_norm(k,i)*dc_norm(j,i+1)
1450 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1452 c uyder(j,j,1)=uyder(j,j,1)-costh
1453 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1454 uyder(j,j,1)=uyder(j,j,1)
1455 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1456 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1462 uygrad(l,k,j,i)=uyder(l,k,j)
1463 uzgrad(l,k,j,i)=uzder(l,k,j)
1467 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1468 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1469 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1470 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1477 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1478 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1485 C-----------------------------------------------------------------------------
1486 subroutine check_vecgrad
1487 implicit real*8 (a-h,o-z)
1488 include 'DIMENSIONS'
1489 include 'DIMENSIONS.ZSCOPT'
1490 include 'COMMON.IOUNITS'
1491 include 'COMMON.GEO'
1492 include 'COMMON.VAR'
1493 include 'COMMON.LOCAL'
1494 include 'COMMON.CHAIN'
1495 include 'COMMON.VECTORS'
1496 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1497 dimension uyt(3,maxres),uzt(3,maxres)
1498 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1499 double precision delta /1.0d-7/
1502 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1503 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1504 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1505 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1506 cd & (dc_norm(if90,i),if90=1,3)
1507 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1508 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1509 cd write(iout,'(a)')
1515 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1516 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1529 cd write (iout,*) 'i=',i
1531 erij(k)=dc_norm(k,i)
1535 dc_norm(k,i)=erij(k)
1537 dc_norm(j,i)=dc_norm(j,i)+delta
1538 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1540 c dc_norm(k,i)=dc_norm(k,i)/fac
1542 c write (iout,*) (dc_norm(k,i),k=1,3)
1543 c write (iout,*) (erij(k),k=1,3)
1546 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1547 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1548 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1549 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1551 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1552 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1553 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1556 dc_norm(k,i)=erij(k)
1559 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1560 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1561 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1562 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1563 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1564 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1565 cd write (iout,'(a)')
1570 C--------------------------------------------------------------------------
1571 subroutine set_matrices
1572 implicit real*8 (a-h,o-z)
1573 include 'DIMENSIONS'
1574 include 'DIMENSIONS.ZSCOPT'
1575 include 'COMMON.IOUNITS'
1576 include 'COMMON.GEO'
1577 include 'COMMON.VAR'
1578 include 'COMMON.LOCAL'
1579 include 'COMMON.CHAIN'
1580 include 'COMMON.DERIV'
1581 include 'COMMON.INTERACT'
1582 include 'COMMON.CONTACTS'
1583 include 'COMMON.TORSION'
1584 include 'COMMON.VECTORS'
1585 include 'COMMON.FFIELD'
1586 double precision auxvec(2),auxmat(2,2)
1588 C Compute the virtual-bond-torsional-angle dependent quantities needed
1589 C to calculate the el-loc multibody terms of various order.
1592 if (i .lt. nres+1) then
1629 if (i .gt. 3 .and. i .lt. nres+1) then
1630 obrot_der(1,i-2)=-sin1
1631 obrot_der(2,i-2)= cos1
1632 Ugder(1,1,i-2)= sin1
1633 Ugder(1,2,i-2)=-cos1
1634 Ugder(2,1,i-2)=-cos1
1635 Ugder(2,2,i-2)=-sin1
1638 obrot2_der(1,i-2)=-dwasin2
1639 obrot2_der(2,i-2)= dwacos2
1640 Ug2der(1,1,i-2)= dwasin2
1641 Ug2der(1,2,i-2)=-dwacos2
1642 Ug2der(2,1,i-2)=-dwacos2
1643 Ug2der(2,2,i-2)=-dwasin2
1645 obrot_der(1,i-2)=0.0d0
1646 obrot_der(2,i-2)=0.0d0
1647 Ugder(1,1,i-2)=0.0d0
1648 Ugder(1,2,i-2)=0.0d0
1649 Ugder(2,1,i-2)=0.0d0
1650 Ugder(2,2,i-2)=0.0d0
1651 obrot2_der(1,i-2)=0.0d0
1652 obrot2_der(2,i-2)=0.0d0
1653 Ug2der(1,1,i-2)=0.0d0
1654 Ug2der(1,2,i-2)=0.0d0
1655 Ug2der(2,1,i-2)=0.0d0
1656 Ug2der(2,2,i-2)=0.0d0
1658 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1659 if (itype(i-2).le.ntyp) then
1660 iti = itortyp(itype(i-2))
1667 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1668 if (itype(i-1).le.ntyp) then
1669 iti1 = itortyp(itype(i-1))
1676 cd write (iout,*) '*******i',i,' iti1',iti
1677 cd write (iout,*) 'b1',b1(:,iti)
1678 cd write (iout,*) 'b2',b2(:,iti)
1679 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1680 c print *,"itilde1 i iti iti1",i,iti,iti1
1681 if (i .gt. iatel_s+2) then
1682 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1683 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1684 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1685 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1686 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1687 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1688 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1698 DtUg2(l,k,i-2)=0.0d0
1702 c print *,"itilde2 i iti iti1",i,iti,iti1
1703 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1704 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1705 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1706 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1707 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1708 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1709 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1710 c print *,"itilde3 i iti iti1",i,iti,iti1
1712 muder(k,i-2)=Ub2der(k,i-2)
1714 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1715 if (itype(i-1).le.ntyp) then
1716 iti1 = itortyp(itype(i-1))
1724 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1726 C Vectors and matrices dependent on a single virtual-bond dihedral.
1727 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1728 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1729 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1730 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1731 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1732 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1733 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1734 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1735 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1736 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1737 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1739 C Matrices dependent on two consecutive virtual-bond dihedrals.
1740 C The order of matrices is from left to right.
1742 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1743 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1744 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1745 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1746 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1747 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1748 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1749 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1752 cd iti = itortyp(itype(i))
1755 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1756 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1761 C--------------------------------------------------------------------------
1762 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1764 C This subroutine calculates the average interaction energy and its gradient
1765 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1766 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1767 C The potential depends both on the distance of peptide-group centers and on
1768 C the orientation of the CA-CA virtual bonds.
1770 implicit real*8 (a-h,o-z)
1771 include 'DIMENSIONS'
1772 include 'DIMENSIONS.ZSCOPT'
1773 include 'COMMON.CONTROL'
1774 include 'COMMON.IOUNITS'
1775 include 'COMMON.GEO'
1776 include 'COMMON.VAR'
1777 include 'COMMON.LOCAL'
1778 include 'COMMON.CHAIN'
1779 include 'COMMON.DERIV'
1780 include 'COMMON.INTERACT'
1781 include 'COMMON.CONTACTS'
1782 include 'COMMON.TORSION'
1783 include 'COMMON.VECTORS'
1784 include 'COMMON.FFIELD'
1785 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1786 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1787 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1788 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1789 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1790 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1791 double precision scal_el /0.5d0/
1793 C 13-go grudnia roku pamietnego...
1794 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1795 & 0.0d0,1.0d0,0.0d0,
1796 & 0.0d0,0.0d0,1.0d0/
1797 cd write(iout,*) 'In EELEC'
1799 cd write(iout,*) 'Type',i
1800 cd write(iout,*) 'B1',B1(:,i)
1801 cd write(iout,*) 'B2',B2(:,i)
1802 cd write(iout,*) 'CC',CC(:,:,i)
1803 cd write(iout,*) 'DD',DD(:,:,i)
1804 cd write(iout,*) 'EE',EE(:,:,i)
1806 cd call check_vecgrad
1808 if (icheckgrad.eq.1) then
1810 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1812 dc_norm(k,i)=dc(k,i)*fac
1814 c write (iout,*) 'i',i,' fac',fac
1817 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1818 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1819 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1820 cd if (wel_loc.gt.0.0d0) then
1821 if (icheckgrad.eq.1) then
1822 call vec_and_deriv_test
1829 cd write (iout,*) 'i=',i
1831 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1834 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1835 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1848 cd print '(a)','Enter EELEC'
1849 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1851 gel_loc_loc(i)=0.0d0
1854 do i=iatel_s,iatel_e
1855 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
1856 if (itel(i).eq.0) goto 1215
1860 dx_normi=dc_norm(1,i)
1861 dy_normi=dc_norm(2,i)
1862 dz_normi=dc_norm(3,i)
1863 xmedi=c(1,i)+0.5d0*dxi
1864 ymedi=c(2,i)+0.5d0*dyi
1865 zmedi=c(3,i)+0.5d0*dzi
1867 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1868 do j=ielstart(i),ielend(i)
1869 if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
1870 if (itel(j).eq.0) goto 1216
1874 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1875 aaa=app(iteli,itelj)
1876 bbb=bpp(iteli,itelj)
1877 C Diagnostics only!!!
1883 ael6i=ael6(iteli,itelj)
1884 ael3i=ael3(iteli,itelj)
1888 dx_normj=dc_norm(1,j)
1889 dy_normj=dc_norm(2,j)
1890 dz_normj=dc_norm(3,j)
1891 xj=c(1,j)+0.5D0*dxj-xmedi
1892 yj=c(2,j)+0.5D0*dyj-ymedi
1893 zj=c(3,j)+0.5D0*dzj-zmedi
1894 rij=xj*xj+yj*yj+zj*zj
1900 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1901 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1902 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1903 fac=cosa-3.0D0*cosb*cosg
1905 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1906 if (j.eq.i+2) ev1=scal_el*ev1
1911 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1914 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1915 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1916 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1919 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1920 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1921 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1922 cd & xmedi,ymedi,zmedi,xj,yj,zj
1924 C Calculate contributions to the Cartesian gradient.
1927 facvdw=-6*rrmij*(ev1+evdwij)
1928 facel=-3*rrmij*(el1+eesij)
1935 * Radial derivatives. First process both termini of the fragment (i,j)
1942 gelc(k,i)=gelc(k,i)+ghalf
1943 gelc(k,j)=gelc(k,j)+ghalf
1946 * Loop over residues i+1 thru j-1.
1950 gelc(l,k)=gelc(l,k)+ggg(l)
1958 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1959 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1962 * Loop over residues i+1 thru j-1.
1966 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1973 fac=-3*rrmij*(facvdw+facvdw+facel)
1979 * Radial derivatives. First process both termini of the fragment (i,j)
1986 gelc(k,i)=gelc(k,i)+ghalf
1987 gelc(k,j)=gelc(k,j)+ghalf
1990 * Loop over residues i+1 thru j-1.
1994 gelc(l,k)=gelc(l,k)+ggg(l)
2001 ecosa=2.0D0*fac3*fac1+fac4
2004 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2005 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2007 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2008 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2010 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2011 cd & (dcosg(k),k=1,3)
2013 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2017 gelc(k,i)=gelc(k,i)+ghalf
2018 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2019 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2020 gelc(k,j)=gelc(k,j)+ghalf
2021 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2022 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2026 gelc(l,k)=gelc(l,k)+ggg(l)
2031 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2032 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2033 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2035 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2036 C energy of a peptide unit is assumed in the form of a second-order
2037 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2038 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2039 C are computed for EVERY pair of non-contiguous peptide groups.
2041 if (j.lt.nres-1) then
2052 muij(kkk)=mu(k,i)*mu(l,j)
2055 cd write (iout,*) 'EELEC: i',i,' j',j
2056 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2057 cd write(iout,*) 'muij',muij
2058 ury=scalar(uy(1,i),erij)
2059 urz=scalar(uz(1,i),erij)
2060 vry=scalar(uy(1,j),erij)
2061 vrz=scalar(uz(1,j),erij)
2062 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2063 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2064 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2065 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2066 C For diagnostics only
2071 fac=dsqrt(-ael6i)*r3ij
2072 cd write (2,*) 'fac=',fac
2073 C For diagnostics only
2079 cd write (iout,'(4i5,4f10.5)')
2080 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2081 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2082 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2083 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2084 cd write (iout,'(4f10.5)')
2085 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2086 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2087 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2088 cd write (iout,'(2i3,9f10.5/)') i,j,
2089 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2091 C Derivatives of the elements of A in virtual-bond vectors
2092 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2099 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2100 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2101 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2102 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2103 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2104 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2105 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2106 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2107 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2108 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2109 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2110 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2120 C Compute radial contributions to the gradient
2142 C Add the contributions coming from er
2145 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2146 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2147 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2148 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2151 C Derivatives in DC(i)
2152 ghalf1=0.5d0*agg(k,1)
2153 ghalf2=0.5d0*agg(k,2)
2154 ghalf3=0.5d0*agg(k,3)
2155 ghalf4=0.5d0*agg(k,4)
2156 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2157 & -3.0d0*uryg(k,2)*vry)+ghalf1
2158 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2159 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2160 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2161 & -3.0d0*urzg(k,2)*vry)+ghalf3
2162 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2163 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2164 C Derivatives in DC(i+1)
2165 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2166 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2167 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2168 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2169 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2170 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2171 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2172 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2173 C Derivatives in DC(j)
2174 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2175 & -3.0d0*vryg(k,2)*ury)+ghalf1
2176 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2177 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2178 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2179 & -3.0d0*vryg(k,2)*urz)+ghalf3
2180 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2181 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2182 C Derivatives in DC(j+1) or DC(nres-1)
2183 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2184 & -3.0d0*vryg(k,3)*ury)
2185 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2186 & -3.0d0*vrzg(k,3)*ury)
2187 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2188 & -3.0d0*vryg(k,3)*urz)
2189 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2190 & -3.0d0*vrzg(k,3)*urz)
2195 C Derivatives in DC(i+1)
2196 cd aggi1(k,1)=agg(k,1)
2197 cd aggi1(k,2)=agg(k,2)
2198 cd aggi1(k,3)=agg(k,3)
2199 cd aggi1(k,4)=agg(k,4)
2200 C Derivatives in DC(j)
2205 C Derivatives in DC(j+1)
2210 if (j.eq.nres-1 .and. i.lt.j-2) then
2212 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2213 cd aggj1(k,l)=agg(k,l)
2219 C Check the loc-el terms by numerical integration
2229 aggi(k,l)=-aggi(k,l)
2230 aggi1(k,l)=-aggi1(k,l)
2231 aggj(k,l)=-aggj(k,l)
2232 aggj1(k,l)=-aggj1(k,l)
2235 if (j.lt.nres-1) then
2241 aggi(k,l)=-aggi(k,l)
2242 aggi1(k,l)=-aggi1(k,l)
2243 aggj(k,l)=-aggj(k,l)
2244 aggj1(k,l)=-aggj1(k,l)
2255 aggi(k,l)=-aggi(k,l)
2256 aggi1(k,l)=-aggi1(k,l)
2257 aggj(k,l)=-aggj(k,l)
2258 aggj1(k,l)=-aggj1(k,l)
2264 IF (wel_loc.gt.0.0d0) THEN
2265 C Contribution to the local-electrostatic energy coming from the i-j pair
2266 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2268 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2269 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2270 eel_loc=eel_loc+eel_loc_ij
2271 C Partial derivatives in virtual-bond dihedral angles gamma
2274 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2275 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2276 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2277 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2278 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2279 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2280 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2281 cd write(iout,*) 'agg ',agg
2282 cd write(iout,*) 'aggi ',aggi
2283 cd write(iout,*) 'aggi1',aggi1
2284 cd write(iout,*) 'aggj ',aggj
2285 cd write(iout,*) 'aggj1',aggj1
2287 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2289 ggg(l)=agg(l,1)*muij(1)+
2290 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2294 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2297 C Remaining derivatives of eello
2299 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2300 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2301 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2302 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2303 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2304 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2305 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2306 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2310 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2311 C Contributions from turns
2316 call eturn34(i,j,eello_turn3,eello_turn4)
2318 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2319 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2321 C Calculate the contact function. The ith column of the array JCONT will
2322 C contain the numbers of atoms that make contacts with the atom I (of numbers
2323 C greater than I). The arrays FACONT and GACONT will contain the values of
2324 C the contact function and its derivative.
2325 c r0ij=1.02D0*rpp(iteli,itelj)
2326 c r0ij=1.11D0*rpp(iteli,itelj)
2327 r0ij=2.20D0*rpp(iteli,itelj)
2328 c r0ij=1.55D0*rpp(iteli,itelj)
2329 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2330 if (fcont.gt.0.0D0) then
2331 num_conti=num_conti+1
2332 if (num_conti.gt.maxconts) then
2333 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2334 & ' will skip next contacts for this conf.'
2336 jcont_hb(num_conti,i)=j
2337 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2338 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2339 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2341 d_cont(num_conti,i)=rij
2342 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2343 C --- Electrostatic-interaction matrix ---
2344 a_chuj(1,1,num_conti,i)=a22
2345 a_chuj(1,2,num_conti,i)=a23
2346 a_chuj(2,1,num_conti,i)=a32
2347 a_chuj(2,2,num_conti,i)=a33
2348 C --- Gradient of rij
2350 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2353 c a_chuj(1,1,num_conti,i)=-0.61d0
2354 c a_chuj(1,2,num_conti,i)= 0.4d0
2355 c a_chuj(2,1,num_conti,i)= 0.65d0
2356 c a_chuj(2,2,num_conti,i)= 0.50d0
2357 c else if (i.eq.2) then
2358 c a_chuj(1,1,num_conti,i)= 0.0d0
2359 c a_chuj(1,2,num_conti,i)= 0.0d0
2360 c a_chuj(2,1,num_conti,i)= 0.0d0
2361 c a_chuj(2,2,num_conti,i)= 0.0d0
2363 C --- and its gradients
2364 cd write (iout,*) 'i',i,' j',j
2366 cd write (iout,*) 'iii 1 kkk',kkk
2367 cd write (iout,*) agg(kkk,:)
2370 cd write (iout,*) 'iii 2 kkk',kkk
2371 cd write (iout,*) aggi(kkk,:)
2374 cd write (iout,*) 'iii 3 kkk',kkk
2375 cd write (iout,*) aggi1(kkk,:)
2378 cd write (iout,*) 'iii 4 kkk',kkk
2379 cd write (iout,*) aggj(kkk,:)
2382 cd write (iout,*) 'iii 5 kkk',kkk
2383 cd write (iout,*) aggj1(kkk,:)
2390 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2391 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2392 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2393 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2394 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2396 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2402 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2403 C Calculate contact energies
2405 wij=cosa-3.0D0*cosb*cosg
2408 c fac3=dsqrt(-ael6i)/r0ij**3
2409 fac3=dsqrt(-ael6i)*r3ij
2410 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2411 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2413 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2414 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2415 C Diagnostics. Comment out or remove after debugging!
2416 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2417 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2418 c ees0m(num_conti,i)=0.0D0
2420 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2421 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2422 facont_hb(num_conti,i)=fcont
2424 C Angular derivatives of the contact function
2425 ees0pij1=fac3/ees0pij
2426 ees0mij1=fac3/ees0mij
2427 fac3p=-3.0D0*fac3*rrmij
2428 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2429 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2431 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2432 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2433 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2434 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2435 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2436 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2437 ecosap=ecosa1+ecosa2
2438 ecosbp=ecosb1+ecosb2
2439 ecosgp=ecosg1+ecosg2
2440 ecosam=ecosa1-ecosa2
2441 ecosbm=ecosb1-ecosb2
2442 ecosgm=ecosg1-ecosg2
2451 fprimcont=fprimcont/rij
2452 cd facont_hb(num_conti,i)=1.0D0
2453 C Following line is for diagnostics.
2456 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2457 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2460 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2461 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2463 gggp(1)=gggp(1)+ees0pijp*xj
2464 gggp(2)=gggp(2)+ees0pijp*yj
2465 gggp(3)=gggp(3)+ees0pijp*zj
2466 gggm(1)=gggm(1)+ees0mijp*xj
2467 gggm(2)=gggm(2)+ees0mijp*yj
2468 gggm(3)=gggm(3)+ees0mijp*zj
2469 C Derivatives due to the contact function
2470 gacont_hbr(1,num_conti,i)=fprimcont*xj
2471 gacont_hbr(2,num_conti,i)=fprimcont*yj
2472 gacont_hbr(3,num_conti,i)=fprimcont*zj
2474 ghalfp=0.5D0*gggp(k)
2475 ghalfm=0.5D0*gggm(k)
2476 gacontp_hb1(k,num_conti,i)=ghalfp
2477 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2478 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2479 gacontp_hb2(k,num_conti,i)=ghalfp
2480 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2481 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2482 gacontp_hb3(k,num_conti,i)=gggp(k)
2483 gacontm_hb1(k,num_conti,i)=ghalfm
2484 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2485 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2486 gacontm_hb2(k,num_conti,i)=ghalfm
2487 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2488 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2489 gacontm_hb3(k,num_conti,i)=gggm(k)
2492 C Diagnostics. Comment out or remove after debugging!
2494 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2495 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2496 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2497 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2498 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2499 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2502 endif ! num_conti.le.maxconts
2507 num_cont_hb(i)=num_conti
2511 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2512 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2514 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2515 ccc eel_loc=eel_loc+eello_turn3
2518 C-----------------------------------------------------------------------------
2519 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2520 C Third- and fourth-order contributions from turns
2521 implicit real*8 (a-h,o-z)
2522 include 'DIMENSIONS'
2523 include 'DIMENSIONS.ZSCOPT'
2524 include 'COMMON.IOUNITS'
2525 include 'COMMON.GEO'
2526 include 'COMMON.VAR'
2527 include 'COMMON.LOCAL'
2528 include 'COMMON.CHAIN'
2529 include 'COMMON.DERIV'
2530 include 'COMMON.INTERACT'
2531 include 'COMMON.CONTACTS'
2532 include 'COMMON.TORSION'
2533 include 'COMMON.VECTORS'
2534 include 'COMMON.FFIELD'
2536 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2537 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2538 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2539 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2540 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2541 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2543 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2545 C Third-order contributions
2552 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2553 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2554 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2555 call transpose2(auxmat(1,1),auxmat1(1,1))
2556 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2557 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2558 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2559 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2560 cd & ' eello_turn3_num',4*eello_turn3_num
2562 C Derivatives in gamma(i)
2563 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2564 call transpose2(auxmat2(1,1),pizda(1,1))
2565 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2566 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2567 C Derivatives in gamma(i+1)
2568 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2569 call transpose2(auxmat2(1,1),pizda(1,1))
2570 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2571 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2572 & +0.5d0*(pizda(1,1)+pizda(2,2))
2573 C Cartesian derivatives
2575 a_temp(1,1)=aggi(l,1)
2576 a_temp(1,2)=aggi(l,2)
2577 a_temp(2,1)=aggi(l,3)
2578 a_temp(2,2)=aggi(l,4)
2579 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2580 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2581 & +0.5d0*(pizda(1,1)+pizda(2,2))
2582 a_temp(1,1)=aggi1(l,1)
2583 a_temp(1,2)=aggi1(l,2)
2584 a_temp(2,1)=aggi1(l,3)
2585 a_temp(2,2)=aggi1(l,4)
2586 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2587 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2588 & +0.5d0*(pizda(1,1)+pizda(2,2))
2589 a_temp(1,1)=aggj(l,1)
2590 a_temp(1,2)=aggj(l,2)
2591 a_temp(2,1)=aggj(l,3)
2592 a_temp(2,2)=aggj(l,4)
2593 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2594 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2595 & +0.5d0*(pizda(1,1)+pizda(2,2))
2596 a_temp(1,1)=aggj1(l,1)
2597 a_temp(1,2)=aggj1(l,2)
2598 a_temp(2,1)=aggj1(l,3)
2599 a_temp(2,2)=aggj1(l,4)
2600 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2601 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2602 & +0.5d0*(pizda(1,1)+pizda(2,2))
2605 else if (j.eq.i+3 .and. itype(i+2).ne.21) then
2606 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2608 C Fourth-order contributions
2616 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2617 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2618 iti1=itortyp(itype(i+1))
2619 iti2=itortyp(itype(i+2))
2620 iti3=itortyp(itype(i+3))
2621 call transpose2(EUg(1,1,i+1),e1t(1,1))
2622 call transpose2(Eug(1,1,i+2),e2t(1,1))
2623 call transpose2(Eug(1,1,i+3),e3t(1,1))
2624 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2625 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2626 s1=scalar2(b1(1,iti2),auxvec(1))
2627 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2628 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2629 s2=scalar2(b1(1,iti1),auxvec(1))
2630 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2631 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2632 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2633 eello_turn4=eello_turn4-(s1+s2+s3)
2634 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2635 cd & ' eello_turn4_num',8*eello_turn4_num
2636 C Derivatives in gamma(i)
2638 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2639 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2640 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2641 s1=scalar2(b1(1,iti2),auxvec(1))
2642 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2643 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2644 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2645 C Derivatives in gamma(i+1)
2646 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2647 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2648 s2=scalar2(b1(1,iti1),auxvec(1))
2649 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2650 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2651 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2652 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2653 C Derivatives in gamma(i+2)
2654 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2655 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2656 s1=scalar2(b1(1,iti2),auxvec(1))
2657 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2658 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2659 s2=scalar2(b1(1,iti1),auxvec(1))
2660 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2661 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2662 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2663 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2664 C Cartesian derivatives
2665 C Derivatives of this turn contributions in DC(i+2)
2666 if (j.lt.nres-1) then
2668 a_temp(1,1)=agg(l,1)
2669 a_temp(1,2)=agg(l,2)
2670 a_temp(2,1)=agg(l,3)
2671 a_temp(2,2)=agg(l,4)
2672 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2673 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2674 s1=scalar2(b1(1,iti2),auxvec(1))
2675 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2676 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2677 s2=scalar2(b1(1,iti1),auxvec(1))
2678 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2679 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2680 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2682 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2685 C Remaining derivatives of this turn contribution
2687 a_temp(1,1)=aggi(l,1)
2688 a_temp(1,2)=aggi(l,2)
2689 a_temp(2,1)=aggi(l,3)
2690 a_temp(2,2)=aggi(l,4)
2691 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2692 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2693 s1=scalar2(b1(1,iti2),auxvec(1))
2694 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2695 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2696 s2=scalar2(b1(1,iti1),auxvec(1))
2697 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2698 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2699 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2700 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2701 a_temp(1,1)=aggi1(l,1)
2702 a_temp(1,2)=aggi1(l,2)
2703 a_temp(2,1)=aggi1(l,3)
2704 a_temp(2,2)=aggi1(l,4)
2705 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2706 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2707 s1=scalar2(b1(1,iti2),auxvec(1))
2708 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2709 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2710 s2=scalar2(b1(1,iti1),auxvec(1))
2711 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2712 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2713 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2714 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2715 a_temp(1,1)=aggj(l,1)
2716 a_temp(1,2)=aggj(l,2)
2717 a_temp(2,1)=aggj(l,3)
2718 a_temp(2,2)=aggj(l,4)
2719 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2720 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2721 s1=scalar2(b1(1,iti2),auxvec(1))
2722 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2723 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2724 s2=scalar2(b1(1,iti1),auxvec(1))
2725 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2726 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2727 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2728 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2729 a_temp(1,1)=aggj1(l,1)
2730 a_temp(1,2)=aggj1(l,2)
2731 a_temp(2,1)=aggj1(l,3)
2732 a_temp(2,2)=aggj1(l,4)
2733 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2734 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2735 s1=scalar2(b1(1,iti2),auxvec(1))
2736 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2737 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2738 s2=scalar2(b1(1,iti1),auxvec(1))
2739 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2740 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2741 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2742 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2748 C-----------------------------------------------------------------------------
2749 subroutine vecpr(u,v,w)
2750 implicit real*8(a-h,o-z)
2751 dimension u(3),v(3),w(3)
2752 w(1)=u(2)*v(3)-u(3)*v(2)
2753 w(2)=-u(1)*v(3)+u(3)*v(1)
2754 w(3)=u(1)*v(2)-u(2)*v(1)
2757 C-----------------------------------------------------------------------------
2758 subroutine unormderiv(u,ugrad,unorm,ungrad)
2759 C This subroutine computes the derivatives of a normalized vector u, given
2760 C the derivatives computed without normalization conditions, ugrad. Returns
2763 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2764 double precision vec(3)
2765 double precision scalar
2767 c write (2,*) 'ugrad',ugrad
2770 vec(i)=scalar(ugrad(1,i),u(1))
2772 c write (2,*) 'vec',vec
2775 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2778 c write (2,*) 'ungrad',ungrad
2781 C-----------------------------------------------------------------------------
2782 subroutine escp(evdw2,evdw2_14)
2784 C This subroutine calculates the excluded-volume interaction energy between
2785 C peptide-group centers and side chains and its gradient in virtual-bond and
2786 C side-chain vectors.
2788 implicit real*8 (a-h,o-z)
2789 include 'DIMENSIONS'
2790 include 'DIMENSIONS.ZSCOPT'
2791 include 'COMMON.GEO'
2792 include 'COMMON.VAR'
2793 include 'COMMON.LOCAL'
2794 include 'COMMON.CHAIN'
2795 include 'COMMON.DERIV'
2796 include 'COMMON.INTERACT'
2797 include 'COMMON.FFIELD'
2798 include 'COMMON.IOUNITS'
2802 cd print '(a)','Enter ESCP'
2803 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2804 c & ' scal14',scal14
2805 do i=iatscp_s,iatscp_e
2806 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
2808 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2809 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2810 if (iteli.eq.0) goto 1225
2811 xi=0.5D0*(c(1,i)+c(1,i+1))
2812 yi=0.5D0*(c(2,i)+c(2,i+1))
2813 zi=0.5D0*(c(3,i)+c(3,i+1))
2815 do iint=1,nscp_gr(i)
2817 do j=iscpstart(i,iint),iscpend(i,iint)
2819 if (itypj.eq.21) cycle
2820 C Uncomment following three lines for SC-p interactions
2824 C Uncomment following three lines for Ca-p interactions
2828 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2830 e1=fac*fac*aad(itypj,iteli)
2831 e2=fac*bad(itypj,iteli)
2832 if (iabs(j-i) .le. 2) then
2835 evdw2_14=evdw2_14+e1+e2
2838 c write (iout,*) i,j,evdwij
2842 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2844 fac=-(evdwij+e1)*rrij
2849 cd write (iout,*) 'j<i'
2850 C Uncomment following three lines for SC-p interactions
2852 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2855 cd write (iout,*) 'j>i'
2858 C Uncomment following line for SC-p interactions
2859 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2863 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2867 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2868 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2871 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2881 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2882 gradx_scp(j,i)=expon*gradx_scp(j,i)
2885 C******************************************************************************
2889 C To save time the factor EXPON has been extracted from ALL components
2890 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2893 C******************************************************************************
2896 C--------------------------------------------------------------------------
2897 subroutine edis(ehpb)
2899 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2901 implicit real*8 (a-h,o-z)
2902 include 'DIMENSIONS'
2903 include 'DIMENSIONS.ZSCOPT'
2904 include 'COMMON.SBRIDGE'
2905 include 'COMMON.CHAIN'
2906 include 'COMMON.DERIV'
2907 include 'COMMON.VAR'
2908 include 'COMMON.INTERACT'
2911 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2912 cd print *,'link_start=',link_start,' link_end=',link_end
2913 if (link_end.eq.0) return
2914 do i=link_start,link_end
2915 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2916 C CA-CA distance used in regularization of structure.
2919 C iii and jjj point to the residues for which the distance is assigned.
2920 if (ii.gt.nres) then
2927 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2928 C distance and angle dependent SS bond potential.
2929 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2930 call ssbond_ene(iii,jjj,eij)
2933 C Calculate the distance between the two points and its difference from the
2937 C Get the force constant corresponding to this distance.
2939 C Calculate the contribution to energy.
2940 ehpb=ehpb+waga*rdis*rdis
2942 C Evaluate gradient.
2945 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2946 cd & ' waga=',waga,' fac=',fac
2948 ggg(j)=fac*(c(j,jj)-c(j,ii))
2950 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2951 C If this is a SC-SC distance, we need to calculate the contributions to the
2952 C Cartesian gradient in the SC vectors (ghpbx).
2955 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2956 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2961 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2969 C--------------------------------------------------------------------------
2970 subroutine ssbond_ene(i,j,eij)
2972 C Calculate the distance and angle dependent SS-bond potential energy
2973 C using a free-energy function derived based on RHF/6-31G** ab initio
2974 C calculations of diethyl disulfide.
2976 C A. Liwo and U. Kozlowska, 11/24/03
2978 implicit real*8 (a-h,o-z)
2979 include 'DIMENSIONS'
2980 include 'DIMENSIONS.ZSCOPT'
2981 include 'COMMON.SBRIDGE'
2982 include 'COMMON.CHAIN'
2983 include 'COMMON.DERIV'
2984 include 'COMMON.LOCAL'
2985 include 'COMMON.INTERACT'
2986 include 'COMMON.VAR'
2987 include 'COMMON.IOUNITS'
2988 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2993 dxi=dc_norm(1,nres+i)
2994 dyi=dc_norm(2,nres+i)
2995 dzi=dc_norm(3,nres+i)
2996 dsci_inv=dsc_inv(itypi)
2998 dscj_inv=dsc_inv(itypj)
3002 dxj=dc_norm(1,nres+j)
3003 dyj=dc_norm(2,nres+j)
3004 dzj=dc_norm(3,nres+j)
3005 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3010 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3011 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3012 om12=dxi*dxj+dyi*dyj+dzi*dzj
3014 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3015 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3021 deltat12=om2-om1+2.0d0
3023 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3024 & +akct*deltad*deltat12
3025 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3026 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3027 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3028 c & " deltat12",deltat12," eij",eij
3029 ed=2*akcm*deltad+akct*deltat12
3031 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3032 eom1=-2*akth*deltat1-pom1-om2*pom2
3033 eom2= 2*akth*deltat2+pom1-om1*pom2
3036 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3039 ghpbx(k,i)=ghpbx(k,i)-gg(k)
3040 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3041 ghpbx(k,j)=ghpbx(k,j)+gg(k)
3042 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3045 C Calculate the components of the gradient in DC and X
3049 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3054 C--------------------------------------------------------------------------
3055 subroutine ebond(estr)
3057 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3059 implicit real*8 (a-h,o-z)
3060 include 'DIMENSIONS'
3061 include 'DIMENSIONS.ZSCOPT'
3062 include 'COMMON.LOCAL'
3063 include 'COMMON.GEO'
3064 include 'COMMON.INTERACT'
3065 include 'COMMON.DERIV'
3066 include 'COMMON.VAR'
3067 include 'COMMON.CHAIN'
3068 include 'COMMON.IOUNITS'
3069 include 'COMMON.NAMES'
3070 include 'COMMON.FFIELD'
3071 include 'COMMON.CONTROL'
3072 logical energy_dec /.false./
3073 double precision u(3),ud(3)
3075 C write (iout,*) "distchainmax",distchainmax
3077 c write (iout,*) "distchainmax",distchainmax
3079 if (itype(i-1).eq.21 .or. itype(i).eq.21) then
3080 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3082 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3083 & *dc(j,i-1)/vbld(i)
3085 if (energy_dec) write(iout,*)
3086 & "estr1",i,vbld(i),distchainmax,
3087 & gnmr1(vbld(i),-1.0d0,distchainmax)
3089 diff = vbld(i)-vbldp0
3090 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3093 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3098 estr=0.5d0*AKP*estr+estr1
3100 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3104 if (iti.ne.10 .and. iti.ne.21) then
3107 diff=vbld(i+nres)-vbldsc0(1,iti)
3108 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3109 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3110 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3112 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3116 diff=vbld(i+nres)-vbldsc0(j,iti)
3117 ud(j)=aksc(j,iti)*diff
3118 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3132 uprod2=uprod2*u(k)*u(k)
3136 usumsqder=usumsqder+ud(j)*uprod2
3138 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3139 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3140 estr=estr+uprod/usum
3142 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3150 C--------------------------------------------------------------------------
3151 subroutine ebend(etheta)
3153 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3154 C angles gamma and its derivatives in consecutive thetas and gammas.
3156 implicit real*8 (a-h,o-z)
3157 include 'DIMENSIONS'
3158 include 'DIMENSIONS.ZSCOPT'
3159 include 'COMMON.LOCAL'
3160 include 'COMMON.GEO'
3161 include 'COMMON.INTERACT'
3162 include 'COMMON.DERIV'
3163 include 'COMMON.VAR'
3164 include 'COMMON.CHAIN'
3165 include 'COMMON.IOUNITS'
3166 include 'COMMON.NAMES'
3167 include 'COMMON.FFIELD'
3168 common /calcthet/ term1,term2,termm,diffak,ratak,
3169 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3170 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3171 double precision y(2),z(2)
3173 time11=dexp(-2*time)
3176 c write (iout,*) "nres",nres
3177 c write (*,'(a,i2)') 'EBEND ICG=',icg
3178 c write (iout,*) ithet_start,ithet_end
3179 do i=ithet_start,ithet_end
3180 if (itype(i-1).eq.21) cycle
3181 C Zero the energy function and its derivative at 0 or pi.
3182 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3184 if (i.gt.3 .and. itype(i-2).ne.21) then
3188 call proc_proc(phii,icrc)
3189 if (icrc.eq.1) phii=150.0
3199 if (i.lt.nres .and. itype(i).ne.21) then
3203 call proc_proc(phii1,icrc)
3204 if (icrc.eq.1) phii1=150.0
3216 C Calculate the "mean" value of theta from the part of the distribution
3217 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3218 C In following comments this theta will be referred to as t_c.
3219 thet_pred_mean=0.0d0
3223 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3225 c write (iout,*) "thet_pred_mean",thet_pred_mean
3226 dthett=thet_pred_mean*ssd
3227 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3228 c write (iout,*) "thet_pred_mean",thet_pred_mean
3229 C Derivatives of the "mean" values in gamma1 and gamma2.
3230 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3231 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3232 if (theta(i).gt.pi-delta) then
3233 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3235 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3236 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3237 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3239 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3241 else if (theta(i).lt.delta) then
3242 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3243 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3244 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3246 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3247 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3250 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3253 etheta=etheta+ethetai
3254 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3255 c & rad2deg*phii,rad2deg*phii1,ethetai
3256 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3257 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3258 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3261 C Ufff.... We've done all this!!!
3264 C---------------------------------------------------------------------------
3265 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3267 implicit real*8 (a-h,o-z)
3268 include 'DIMENSIONS'
3269 include 'COMMON.LOCAL'
3270 include 'COMMON.IOUNITS'
3271 common /calcthet/ term1,term2,termm,diffak,ratak,
3272 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3273 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3274 C Calculate the contributions to both Gaussian lobes.
3275 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3276 C The "polynomial part" of the "standard deviation" of this part of
3280 sig=sig*thet_pred_mean+polthet(j,it)
3282 C Derivative of the "interior part" of the "standard deviation of the"
3283 C gamma-dependent Gaussian lobe in t_c.
3284 sigtc=3*polthet(3,it)
3286 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3289 C Set the parameters of both Gaussian lobes of the distribution.
3290 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3291 fac=sig*sig+sigc0(it)
3294 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3295 sigsqtc=-4.0D0*sigcsq*sigtc
3296 c print *,i,sig,sigtc,sigsqtc
3297 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3298 sigtc=-sigtc/(fac*fac)
3299 C Following variable is sigma(t_c)**(-2)
3300 sigcsq=sigcsq*sigcsq
3302 sig0inv=1.0D0/sig0i**2
3303 delthec=thetai-thet_pred_mean
3304 delthe0=thetai-theta0i
3305 term1=-0.5D0*sigcsq*delthec*delthec
3306 term2=-0.5D0*sig0inv*delthe0*delthe0
3307 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3308 C NaNs in taking the logarithm. We extract the largest exponent which is added
3309 C to the energy (this being the log of the distribution) at the end of energy
3310 C term evaluation for this virtual-bond angle.
3311 if (term1.gt.term2) then
3313 term2=dexp(term2-termm)
3317 term1=dexp(term1-termm)
3320 C The ratio between the gamma-independent and gamma-dependent lobes of
3321 C the distribution is a Gaussian function of thet_pred_mean too.
3322 diffak=gthet(2,it)-thet_pred_mean
3323 ratak=diffak/gthet(3,it)**2
3324 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3325 C Let's differentiate it in thet_pred_mean NOW.
3327 C Now put together the distribution terms to make complete distribution.
3328 termexp=term1+ak*term2
3329 termpre=sigc+ak*sig0i
3330 C Contribution of the bending energy from this theta is just the -log of
3331 C the sum of the contributions from the two lobes and the pre-exponential
3332 C factor. Simple enough, isn't it?
3333 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3334 C NOW the derivatives!!!
3335 C 6/6/97 Take into account the deformation.
3336 E_theta=(delthec*sigcsq*term1
3337 & +ak*delthe0*sig0inv*term2)/termexp
3338 E_tc=((sigtc+aktc*sig0i)/termpre
3339 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3340 & aktc*term2)/termexp)
3343 c-----------------------------------------------------------------------------
3344 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3345 implicit real*8 (a-h,o-z)
3346 include 'DIMENSIONS'
3347 include 'COMMON.LOCAL'
3348 include 'COMMON.IOUNITS'
3349 common /calcthet/ term1,term2,termm,diffak,ratak,
3350 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3351 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3352 delthec=thetai-thet_pred_mean
3353 delthe0=thetai-theta0i
3354 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3355 t3 = thetai-thet_pred_mean
3359 t14 = t12+t6*sigsqtc
3361 t21 = thetai-theta0i
3367 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3368 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3369 & *(-t12*t9-ak*sig0inv*t27)
3373 C--------------------------------------------------------------------------
3374 subroutine ebend(etheta)
3376 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3377 C angles gamma and its derivatives in consecutive thetas and gammas.
3378 C ab initio-derived potentials from
3379 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3381 implicit real*8 (a-h,o-z)
3382 include 'DIMENSIONS'
3383 include 'DIMENSIONS.ZSCOPT'
3384 include 'COMMON.LOCAL'
3385 include 'COMMON.GEO'
3386 include 'COMMON.INTERACT'
3387 include 'COMMON.DERIV'
3388 include 'COMMON.VAR'
3389 include 'COMMON.CHAIN'
3390 include 'COMMON.IOUNITS'
3391 include 'COMMON.NAMES'
3392 include 'COMMON.FFIELD'
3393 include 'COMMON.CONTROL'
3394 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3395 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3396 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3397 & sinph1ph2(maxdouble,maxdouble)
3398 logical lprn /.false./, lprn1 /.false./
3400 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3401 do i=ithet_start,ithet_end
3402 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3403 &(itype(i).eq.ntyp1)) cycle
3407 theti2=0.5d0*theta(i)
3408 ityp2=ithetyp(itype(i-1))
3410 coskt(k)=dcos(k*theti2)
3411 sinkt(k)=dsin(k*theti2)
3413 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
3416 if (phii.ne.phii) phii=150.0
3420 ityp1=ithetyp(itype(i-2))
3422 cosph1(k)=dcos(k*phii)
3423 sinph1(k)=dsin(k*phii)
3427 ityp1=ithetyp(itype(i-2))
3433 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3436 if (phii1.ne.phii1) phii1=150.0
3441 ityp3=ithetyp(itype(i))
3443 cosph2(k)=dcos(k*phii1)
3444 sinph2(k)=dsin(k*phii1)
3448 ityp3=ithetyp(itype(i))
3454 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3455 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3457 ethetai=aa0thet(ityp1,ityp2,ityp3)
3460 ccl=cosph1(l)*cosph2(k-l)
3461 ssl=sinph1(l)*sinph2(k-l)
3462 scl=sinph1(l)*cosph2(k-l)
3463 csl=cosph1(l)*sinph2(k-l)
3464 cosph1ph2(l,k)=ccl-ssl
3465 cosph1ph2(k,l)=ccl+ssl
3466 sinph1ph2(l,k)=scl+csl
3467 sinph1ph2(k,l)=scl-csl
3471 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3472 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3473 write (iout,*) "coskt and sinkt"
3475 write (iout,*) k,coskt(k),sinkt(k)
3479 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3480 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3483 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3484 & " ethetai",ethetai
3487 write (iout,*) "cosph and sinph"
3489 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3491 write (iout,*) "cosph1ph2 and sinph2ph2"
3494 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3495 & sinph1ph2(l,k),sinph1ph2(k,l)
3498 write(iout,*) "ethetai",ethetai
3502 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3503 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3504 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3505 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3506 ethetai=ethetai+sinkt(m)*aux
3507 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3508 dephii=dephii+k*sinkt(m)*(
3509 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3510 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3511 dephii1=dephii1+k*sinkt(m)*(
3512 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3513 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3515 & write (iout,*) "m",m," k",k," bbthet",
3516 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3517 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3518 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3519 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3523 & write(iout,*) "ethetai",ethetai
3527 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3528 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3529 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3530 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3531 ethetai=ethetai+sinkt(m)*aux
3532 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3533 dephii=dephii+l*sinkt(m)*(
3534 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3535 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3536 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3537 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3538 dephii1=dephii1+(k-l)*sinkt(m)*(
3539 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3540 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3541 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3542 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3544 write (iout,*) "m",m," k",k," l",l," ffthet",
3545 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3546 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3547 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3548 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3549 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3550 & cosph1ph2(k,l)*sinkt(m),
3551 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3557 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3558 & i,theta(i)*rad2deg,phii*rad2deg,
3559 & phii1*rad2deg,ethetai
3560 etheta=etheta+ethetai
3561 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3562 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3563 gloc(nphi+i-2,icg)=wang*dethetai
3569 c-----------------------------------------------------------------------------
3570 subroutine esc(escloc)
3571 C Calculate the local energy of a side chain and its derivatives in the
3572 C corresponding virtual-bond valence angles THETA and the spherical angles
3574 implicit real*8 (a-h,o-z)
3575 include 'DIMENSIONS'
3576 include 'DIMENSIONS.ZSCOPT'
3577 include 'COMMON.GEO'
3578 include 'COMMON.LOCAL'
3579 include 'COMMON.VAR'
3580 include 'COMMON.INTERACT'
3581 include 'COMMON.DERIV'
3582 include 'COMMON.CHAIN'
3583 include 'COMMON.IOUNITS'
3584 include 'COMMON.NAMES'
3585 include 'COMMON.FFIELD'
3586 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3587 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3588 common /sccalc/ time11,time12,time112,theti,it,nlobit
3591 c write (iout,'(a)') 'ESC'
3592 do i=loc_start,loc_end
3595 if (it.eq.10) goto 1
3597 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3598 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3599 theti=theta(i+1)-pipol
3603 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3605 if (x(2).gt.pi-delta) then
3609 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3611 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3612 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3614 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3615 & ddersc0(1),dersc(1))
3616 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3617 & ddersc0(3),dersc(3))
3619 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3621 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3622 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3623 & dersc0(2),esclocbi,dersc02)
3624 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3626 call splinthet(x(2),0.5d0*delta,ss,ssd)
3631 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3633 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3634 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3636 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3638 c write (iout,*) escloci
3639 else if (x(2).lt.delta) then
3643 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3645 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3646 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3648 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3649 & ddersc0(1),dersc(1))
3650 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3651 & ddersc0(3),dersc(3))
3653 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3655 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3656 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3657 & dersc0(2),esclocbi,dersc02)
3658 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3663 call splinthet(x(2),0.5d0*delta,ss,ssd)
3665 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3667 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3668 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3670 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3671 c write (iout,*) escloci
3673 call enesc(x,escloci,dersc,ddummy,.false.)
3676 escloc=escloc+escloci
3677 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3679 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3681 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3682 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3687 C---------------------------------------------------------------------------
3688 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3689 implicit real*8 (a-h,o-z)
3690 include 'DIMENSIONS'
3691 include 'COMMON.GEO'
3692 include 'COMMON.LOCAL'
3693 include 'COMMON.IOUNITS'
3694 common /sccalc/ time11,time12,time112,theti,it,nlobit
3695 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3696 double precision contr(maxlob,-1:1)
3698 c write (iout,*) 'it=',it,' nlobit=',nlobit
3702 if (mixed) ddersc(j)=0.0d0
3706 C Because of periodicity of the dependence of the SC energy in omega we have
3707 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3708 C To avoid underflows, first compute & store the exponents.
3716 z(k)=x(k)-censc(k,j,it)
3721 Axk=Axk+gaussc(l,k,j,it)*z(l)
3727 expfac=expfac+Ax(k,j,iii)*z(k)
3735 C As in the case of ebend, we want to avoid underflows in exponentiation and
3736 C subsequent NaNs and INFs in energy calculation.
3737 C Find the largest exponent
3741 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3745 cd print *,'it=',it,' emin=',emin
3747 C Compute the contribution to SC energy and derivatives
3751 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3752 cd print *,'j=',j,' expfac=',expfac
3753 escloc_i=escloc_i+expfac
3755 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3759 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3760 & +gaussc(k,2,j,it))*expfac
3767 dersc(1)=dersc(1)/cos(theti)**2
3768 ddersc(1)=ddersc(1)/cos(theti)**2
3771 escloci=-(dlog(escloc_i)-emin)
3773 dersc(j)=dersc(j)/escloc_i
3777 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3782 C------------------------------------------------------------------------------
3783 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3784 implicit real*8 (a-h,o-z)
3785 include 'DIMENSIONS'
3786 include 'COMMON.GEO'
3787 include 'COMMON.LOCAL'
3788 include 'COMMON.IOUNITS'
3789 common /sccalc/ time11,time12,time112,theti,it,nlobit
3790 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3791 double precision contr(maxlob)
3802 z(k)=x(k)-censc(k,j,it)
3808 Axk=Axk+gaussc(l,k,j,it)*z(l)
3814 expfac=expfac+Ax(k,j)*z(k)
3819 C As in the case of ebend, we want to avoid underflows in exponentiation and
3820 C subsequent NaNs and INFs in energy calculation.
3821 C Find the largest exponent
3824 if (emin.gt.contr(j)) emin=contr(j)
3828 C Compute the contribution to SC energy and derivatives
3832 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3833 escloc_i=escloc_i+expfac
3835 dersc(k)=dersc(k)+Ax(k,j)*expfac
3837 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3838 & +gaussc(1,2,j,it))*expfac
3842 dersc(1)=dersc(1)/cos(theti)**2
3843 dersc12=dersc12/cos(theti)**2
3844 escloci=-(dlog(escloc_i)-emin)
3846 dersc(j)=dersc(j)/escloc_i
3848 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3852 c----------------------------------------------------------------------------------
3853 subroutine esc(escloc)
3854 C Calculate the local energy of a side chain and its derivatives in the
3855 C corresponding virtual-bond valence angles THETA and the spherical angles
3856 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3857 C added by Urszula Kozlowska. 07/11/2007
3859 implicit real*8 (a-h,o-z)
3860 include 'DIMENSIONS'
3861 include 'DIMENSIONS.ZSCOPT'
3862 include 'COMMON.GEO'
3863 include 'COMMON.LOCAL'
3864 include 'COMMON.VAR'
3865 include 'COMMON.SCROT'
3866 include 'COMMON.INTERACT'
3867 include 'COMMON.DERIV'
3868 include 'COMMON.CHAIN'
3869 include 'COMMON.IOUNITS'
3870 include 'COMMON.NAMES'
3871 include 'COMMON.FFIELD'
3872 include 'COMMON.CONTROL'
3873 include 'COMMON.VECTORS'
3874 double precision x_prime(3),y_prime(3),z_prime(3)
3875 & , sumene,dsc_i,dp2_i,x(65),
3876 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3877 & de_dxx,de_dyy,de_dzz,de_dt
3878 double precision s1_t,s1_6_t,s2_t,s2_6_t
3880 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3881 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3882 & dt_dCi(3),dt_dCi1(3)
3883 common /sccalc/ time11,time12,time112,theti,it,nlobit
3886 do i=loc_start,loc_end
3887 if (itype(i).eq.21) cycle
3888 costtab(i+1) =dcos(theta(i+1))
3889 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3890 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3891 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3892 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3893 cosfac=dsqrt(cosfac2)
3894 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3895 sinfac=dsqrt(sinfac2)
3897 if (it.eq.10) goto 1
3899 C Compute the axes of tghe local cartesian coordinates system; store in
3900 c x_prime, y_prime and z_prime
3907 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3908 C & dc_norm(3,i+nres)
3910 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3911 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3914 z_prime(j) = -uz(j,i-1)
3917 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3918 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3919 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3920 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3921 c & " xy",scalar(x_prime(1),y_prime(1)),
3922 c & " xz",scalar(x_prime(1),z_prime(1)),
3923 c & " yy",scalar(y_prime(1),y_prime(1)),
3924 c & " yz",scalar(y_prime(1),z_prime(1)),
3925 c & " zz",scalar(z_prime(1),z_prime(1))
3927 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3928 C to local coordinate system. Store in xx, yy, zz.
3934 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3935 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3936 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3943 C Compute the energy of the ith side cbain
3945 c write (2,*) "xx",xx," yy",yy," zz",zz
3948 x(j) = sc_parmin(j,it)
3951 Cc diagnostics - remove later
3953 yy1 = dsin(alph(2))*dcos(omeg(2))
3954 zz1 = -dsin(alph(2))*dsin(omeg(2))
3955 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3956 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3958 C," --- ", xx_w,yy_w,zz_w
3961 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3962 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3964 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3965 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3967 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3968 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3969 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3970 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3971 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3973 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3974 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3975 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3976 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3977 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3979 dsc_i = 0.743d0+x(61)
3981 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3982 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3983 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3984 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3985 s1=(1+x(63))/(0.1d0 + dscp1)
3986 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3987 s2=(1+x(65))/(0.1d0 + dscp2)
3988 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3989 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3990 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3991 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3993 c & dscp1,dscp2,sumene
3994 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3995 escloc = escloc + sumene
3996 c write (2,*) "escloc",escloc
3997 if (.not. calc_grad) goto 1
4000 C This section to check the numerical derivatives of the energy of ith side
4001 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4002 C #define DEBUG in the code to turn it on.
4004 write (2,*) "sumene =",sumene
4008 write (2,*) xx,yy,zz
4009 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4010 de_dxx_num=(sumenep-sumene)/aincr
4012 write (2,*) "xx+ sumene from enesc=",sumenep
4015 write (2,*) xx,yy,zz
4016 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4017 de_dyy_num=(sumenep-sumene)/aincr
4019 write (2,*) "yy+ sumene from enesc=",sumenep
4022 write (2,*) xx,yy,zz
4023 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4024 de_dzz_num=(sumenep-sumene)/aincr
4026 write (2,*) "zz+ sumene from enesc=",sumenep
4027 costsave=cost2tab(i+1)
4028 sintsave=sint2tab(i+1)
4029 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4030 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4031 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4032 de_dt_num=(sumenep-sumene)/aincr
4033 write (2,*) " t+ sumene from enesc=",sumenep
4034 cost2tab(i+1)=costsave
4035 sint2tab(i+1)=sintsave
4036 C End of diagnostics section.
4039 C Compute the gradient of esc
4041 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4042 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4043 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4044 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4045 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4046 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4047 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4048 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4049 pom1=(sumene3*sint2tab(i+1)+sumene1)
4050 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4051 pom2=(sumene4*cost2tab(i+1)+sumene2)
4052 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4053 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4054 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4055 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4057 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4058 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4059 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4061 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4062 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4063 & +(pom1+pom2)*pom_dx
4065 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4068 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4069 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4070 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4072 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4073 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4074 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4075 & +x(59)*zz**2 +x(60)*xx*zz
4076 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4077 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4078 & +(pom1-pom2)*pom_dy
4080 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4083 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4084 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4085 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4086 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4087 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4088 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4089 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4090 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4092 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4095 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4096 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4097 & +pom1*pom_dt1+pom2*pom_dt2
4099 write(2,*), "de_dt = ", de_dt,de_dt_num
4103 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4104 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4105 cosfac2xx=cosfac2*xx
4106 sinfac2yy=sinfac2*yy
4108 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4110 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4112 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4113 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4114 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4115 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4116 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4117 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4118 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4119 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4120 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4121 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4125 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4126 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4129 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4130 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4131 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4133 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4134 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4138 dXX_Ctab(k,i)=dXX_Ci(k)
4139 dXX_C1tab(k,i)=dXX_Ci1(k)
4140 dYY_Ctab(k,i)=dYY_Ci(k)
4141 dYY_C1tab(k,i)=dYY_Ci1(k)
4142 dZZ_Ctab(k,i)=dZZ_Ci(k)
4143 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4144 dXX_XYZtab(k,i)=dXX_XYZ(k)
4145 dYY_XYZtab(k,i)=dYY_XYZ(k)
4146 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4150 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4151 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4152 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4153 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4154 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4156 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4157 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4158 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4159 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4160 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4161 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4162 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4163 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4165 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4166 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4168 C to check gradient call subroutine check_grad
4175 c------------------------------------------------------------------------------
4176 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4178 C This procedure calculates two-body contact function g(rij) and its derivative:
4181 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4184 C where x=(rij-r0ij)/delta
4186 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4189 double precision rij,r0ij,eps0ij,fcont,fprimcont
4190 double precision x,x2,x4,delta
4194 if (x.lt.-1.0D0) then
4197 else if (x.le.1.0D0) then
4200 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4201 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4208 c------------------------------------------------------------------------------
4209 subroutine splinthet(theti,delta,ss,ssder)
4210 implicit real*8 (a-h,o-z)
4211 include 'DIMENSIONS'
4212 include 'DIMENSIONS.ZSCOPT'
4213 include 'COMMON.VAR'
4214 include 'COMMON.GEO'
4217 if (theti.gt.pipol) then
4218 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4220 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4225 c------------------------------------------------------------------------------
4226 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4228 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4229 double precision ksi,ksi2,ksi3,a1,a2,a3
4230 a1=fprim0*delta/(f1-f0)
4236 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4237 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4240 c------------------------------------------------------------------------------
4241 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4243 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4244 double precision ksi,ksi2,ksi3,a1,a2,a3
4249 a2=3*(f1x-f0x)-2*fprim0x*delta
4250 a3=fprim0x*delta-2*(f1x-f0x)
4251 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4254 C-----------------------------------------------------------------------------
4256 C-----------------------------------------------------------------------------
4257 subroutine etor(etors,edihcnstr,fact)
4258 implicit real*8 (a-h,o-z)
4259 include 'DIMENSIONS'
4260 include 'DIMENSIONS.ZSCOPT'
4261 include 'COMMON.VAR'
4262 include 'COMMON.GEO'
4263 include 'COMMON.LOCAL'
4264 include 'COMMON.TORSION'
4265 include 'COMMON.INTERACT'
4266 include 'COMMON.DERIV'
4267 include 'COMMON.CHAIN'
4268 include 'COMMON.NAMES'
4269 include 'COMMON.IOUNITS'
4270 include 'COMMON.FFIELD'
4271 include 'COMMON.TORCNSTR'
4273 C Set lprn=.true. for debugging
4277 do i=iphi_start,iphi_end
4278 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
4279 & .or. itype(i).eq.21) cycle
4280 itori=itortyp(itype(i-2))
4281 itori1=itortyp(itype(i-1))
4284 C Proline-Proline pair is a special case...
4285 if (itori.eq.3 .and. itori1.eq.3) then
4286 if (phii.gt.-dwapi3) then
4288 fac=1.0D0/(1.0D0-cosphi)
4289 etorsi=v1(1,3,3)*fac
4290 etorsi=etorsi+etorsi
4291 etors=etors+etorsi-v1(1,3,3)
4292 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4295 v1ij=v1(j+1,itori,itori1)
4296 v2ij=v2(j+1,itori,itori1)
4299 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4300 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4304 v1ij=v1(j,itori,itori1)
4305 v2ij=v2(j,itori,itori1)
4308 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4309 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4313 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4314 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4315 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4316 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4317 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4319 ! 6/20/98 - dihedral angle constraints
4322 itori=idih_constr(i)
4325 if (difi.gt.drange(i)) then
4327 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4328 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4329 else if (difi.lt.-drange(i)) then
4331 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4332 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4334 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4335 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4337 ! write (iout,*) 'edihcnstr',edihcnstr
4340 c------------------------------------------------------------------------------
4342 subroutine etor(etors,edihcnstr,fact)
4343 implicit real*8 (a-h,o-z)
4344 include 'DIMENSIONS'
4345 include 'DIMENSIONS.ZSCOPT'
4346 include 'COMMON.VAR'
4347 include 'COMMON.GEO'
4348 include 'COMMON.LOCAL'
4349 include 'COMMON.TORSION'
4350 include 'COMMON.INTERACT'
4351 include 'COMMON.DERIV'
4352 include 'COMMON.CHAIN'
4353 include 'COMMON.NAMES'
4354 include 'COMMON.IOUNITS'
4355 include 'COMMON.FFIELD'
4356 include 'COMMON.TORCNSTR'
4358 C Set lprn=.true. for debugging
4362 do i=iphi_start,iphi_end
4363 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
4364 & .or. itype(i).eq.21
4365 & .or. itype(i-3).eq.ntyp1) cycle
4366 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4367 itori=itortyp(itype(i-2))
4368 itori1=itortyp(itype(i-1))
4371 C Regular cosine and sine terms
4372 do j=1,nterm(itori,itori1)
4373 v1ij=v1(j,itori,itori1)
4374 v2ij=v2(j,itori,itori1)
4377 etors=etors+v1ij*cosphi+v2ij*sinphi
4378 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4382 C E = SUM ----------------------------------- - v1
4383 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4385 cosphi=dcos(0.5d0*phii)
4386 sinphi=dsin(0.5d0*phii)
4387 do j=1,nlor(itori,itori1)
4388 vl1ij=vlor1(j,itori,itori1)
4389 vl2ij=vlor2(j,itori,itori1)
4390 vl3ij=vlor3(j,itori,itori1)
4391 pom=vl2ij*cosphi+vl3ij*sinphi
4392 pom1=1.0d0/(pom*pom+1.0d0)
4393 etors=etors+vl1ij*pom1
4395 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4397 C Subtract the constant term
4398 etors=etors-v0(itori,itori1)
4400 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4401 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4402 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4403 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4404 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4407 ! 6/20/98 - dihedral angle constraints
4410 itori=idih_constr(i)
4412 difi=pinorm(phii-phi0(i))
4414 if (difi.gt.drange(i)) then
4416 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4417 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4418 edihi=0.25d0*ftors*difi**4
4419 else if (difi.lt.-drange(i)) then
4421 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4422 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4423 edihi=0.25d0*ftors*difi**4
4427 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4429 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4430 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4432 ! write (iout,*) 'edihcnstr',edihcnstr
4435 c----------------------------------------------------------------------------
4436 subroutine etor_d(etors_d,fact2)
4437 C 6/23/01 Compute double torsional energy
4438 implicit real*8 (a-h,o-z)
4439 include 'DIMENSIONS'
4440 include 'DIMENSIONS.ZSCOPT'
4441 include 'COMMON.VAR'
4442 include 'COMMON.GEO'
4443 include 'COMMON.LOCAL'
4444 include 'COMMON.TORSION'
4445 include 'COMMON.INTERACT'
4446 include 'COMMON.DERIV'
4447 include 'COMMON.CHAIN'
4448 include 'COMMON.NAMES'
4449 include 'COMMON.IOUNITS'
4450 include 'COMMON.FFIELD'
4451 include 'COMMON.TORCNSTR'
4453 C Set lprn=.true. for debugging
4457 do i=iphi_start,iphi_end-1
4458 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
4459 & .or. itype(i).eq.21 .or. itype(i+1).eq.21
4460 & .or. itype(i-3).eq.ntyp1) cycle
4461 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4463 itori=itortyp(itype(i-2))
4464 itori1=itortyp(itype(i-1))
4465 itori2=itortyp(itype(i))
4470 C Regular cosine and sine terms
4471 do j=1,ntermd_1(itori,itori1,itori2)
4472 v1cij=v1c(1,j,itori,itori1,itori2)
4473 v1sij=v1s(1,j,itori,itori1,itori2)
4474 v2cij=v1c(2,j,itori,itori1,itori2)
4475 v2sij=v1s(2,j,itori,itori1,itori2)
4476 cosphi1=dcos(j*phii)
4477 sinphi1=dsin(j*phii)
4478 cosphi2=dcos(j*phii1)
4479 sinphi2=dsin(j*phii1)
4480 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4481 & v2cij*cosphi2+v2sij*sinphi2
4482 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4483 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4485 do k=2,ntermd_2(itori,itori1,itori2)
4487 v1cdij = v2c(k,l,itori,itori1,itori2)
4488 v2cdij = v2c(l,k,itori,itori1,itori2)
4489 v1sdij = v2s(k,l,itori,itori1,itori2)
4490 v2sdij = v2s(l,k,itori,itori1,itori2)
4491 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4492 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4493 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4494 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4495 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4496 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4497 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4498 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4499 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4500 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4503 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4504 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4510 c------------------------------------------------------------------------------
4511 subroutine eback_sc_corr(esccor)
4512 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4513 c conformational states; temporarily implemented as differences
4514 c between UNRES torsional potentials (dependent on three types of
4515 c residues) and the torsional potentials dependent on all 20 types
4516 c of residues computed from AM1 energy surfaces of terminally-blocked
4517 c amino-acid residues.
4518 implicit real*8 (a-h,o-z)
4519 include 'DIMENSIONS'
4520 include 'DIMENSIONS.ZSCOPT'
4521 include 'COMMON.VAR'
4522 include 'COMMON.GEO'
4523 include 'COMMON.LOCAL'
4524 include 'COMMON.TORSION'
4525 include 'COMMON.SCCOR'
4526 include 'COMMON.INTERACT'
4527 include 'COMMON.DERIV'
4528 include 'COMMON.CHAIN'
4529 include 'COMMON.NAMES'
4530 include 'COMMON.IOUNITS'
4531 include 'COMMON.FFIELD'
4532 include 'COMMON.CONTROL'
4534 C Set lprn=.true. for debugging
4537 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4539 do i=itau_start,itau_end
4540 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
4542 isccori=isccortyp(itype(i-2))
4543 isccori1=isccortyp(itype(i-1))
4545 do intertyp=1,3 !intertyp
4546 cc Added 09 May 2012 (Adasko)
4547 cc Intertyp means interaction type of backbone mainchain correlation:
4548 c 1 = SC...Ca...Ca...Ca
4549 c 2 = Ca...Ca...Ca...SC
4550 c 3 = SC...Ca...Ca...SCi
4552 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4553 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4554 & (itype(i-1).eq.ntyp1)))
4555 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4556 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4557 & .or.(itype(i).eq.ntyp1)))
4558 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4559 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4560 & (itype(i-3).eq.ntyp1)))) cycle
4561 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4562 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4564 do j=1,nterm_sccor(isccori,isccori1)
4565 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4566 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4567 cosphi=dcos(j*tauangle(intertyp,i))
4568 sinphi=dsin(j*tauangle(intertyp,i))
4569 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4570 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4572 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
4573 c & nterm_sccor(isccori,isccori1),isccori,isccori1
4574 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
4576 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4577 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4578 & (v1sccor(j,1,itori,itori1),j=1,6)
4579 & ,(v2sccor(j,1,itori,itori1),j=1,6)
4580 c gsccor_loc(i-3)=gloci
4585 c------------------------------------------------------------------------------
4586 subroutine multibody(ecorr)
4587 C This subroutine calculates multi-body contributions to energy following
4588 C the idea of Skolnick et al. If side chains I and J make a contact and
4589 C at the same time side chains I+1 and J+1 make a contact, an extra
4590 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4591 implicit real*8 (a-h,o-z)
4592 include 'DIMENSIONS'
4593 include 'COMMON.IOUNITS'
4594 include 'COMMON.DERIV'
4595 include 'COMMON.INTERACT'
4596 include 'COMMON.CONTACTS'
4597 double precision gx(3),gx1(3)
4600 C Set lprn=.true. for debugging
4604 write (iout,'(a)') 'Contact function values:'
4606 write (iout,'(i2,20(1x,i2,f10.5))')
4607 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4622 num_conti=num_cont(i)
4623 num_conti1=num_cont(i1)
4628 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4629 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4630 cd & ' ishift=',ishift
4631 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4632 C The system gains extra energy.
4633 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4634 endif ! j1==j+-ishift
4643 c------------------------------------------------------------------------------
4644 double precision function esccorr(i,j,k,l,jj,kk)
4645 implicit real*8 (a-h,o-z)
4646 include 'DIMENSIONS'
4647 include 'COMMON.IOUNITS'
4648 include 'COMMON.DERIV'
4649 include 'COMMON.INTERACT'
4650 include 'COMMON.CONTACTS'
4651 double precision gx(3),gx1(3)
4656 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4657 C Calculate the multi-body contribution to energy.
4658 C Calculate multi-body contributions to the gradient.
4659 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4660 cd & k,l,(gacont(m,kk,k),m=1,3)
4662 gx(m) =ekl*gacont(m,jj,i)
4663 gx1(m)=eij*gacont(m,kk,k)
4664 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4665 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4666 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4667 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4671 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4676 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4682 c------------------------------------------------------------------------------
4684 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4685 implicit real*8 (a-h,o-z)
4686 include 'DIMENSIONS'
4687 integer dimen1,dimen2,atom,indx
4688 double precision buffer(dimen1,dimen2)
4689 double precision zapas
4690 common /contacts_hb/ zapas(3,20,maxres,7),
4691 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4692 & num_cont_hb(maxres),jcont_hb(20,maxres)
4693 num_kont=num_cont_hb(atom)
4697 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4700 buffer(i,indx+22)=facont_hb(i,atom)
4701 buffer(i,indx+23)=ees0p(i,atom)
4702 buffer(i,indx+24)=ees0m(i,atom)
4703 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4705 buffer(1,indx+26)=dfloat(num_kont)
4708 c------------------------------------------------------------------------------
4709 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4710 implicit real*8 (a-h,o-z)
4711 include 'DIMENSIONS'
4712 integer dimen1,dimen2,atom,indx
4713 double precision buffer(dimen1,dimen2)
4714 double precision zapas
4715 common /contacts_hb/ zapas(3,20,maxres,7),
4716 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4717 & num_cont_hb(maxres),jcont_hb(20,maxres)
4718 num_kont=buffer(1,indx+26)
4719 num_kont_old=num_cont_hb(atom)
4720 num_cont_hb(atom)=num_kont+num_kont_old
4725 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4728 facont_hb(ii,atom)=buffer(i,indx+22)
4729 ees0p(ii,atom)=buffer(i,indx+23)
4730 ees0m(ii,atom)=buffer(i,indx+24)
4731 jcont_hb(ii,atom)=buffer(i,indx+25)
4735 c------------------------------------------------------------------------------
4737 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4738 C This subroutine calculates multi-body contributions to hydrogen-bonding
4739 implicit real*8 (a-h,o-z)
4740 include 'DIMENSIONS'
4741 include 'DIMENSIONS.ZSCOPT'
4742 include 'COMMON.IOUNITS'
4744 include 'COMMON.INFO'
4746 include 'COMMON.FFIELD'
4747 include 'COMMON.DERIV'
4748 include 'COMMON.INTERACT'
4749 include 'COMMON.CONTACTS'
4751 parameter (max_cont=maxconts)
4752 parameter (max_dim=2*(8*3+2))
4753 parameter (msglen1=max_cont*max_dim*4)
4754 parameter (msglen2=2*msglen1)
4755 integer source,CorrelType,CorrelID,Error
4756 double precision buffer(max_cont,max_dim)
4758 double precision gx(3),gx1(3)
4761 C Set lprn=.true. for debugging
4766 if (fgProcs.le.1) goto 30
4768 write (iout,'(a)') 'Contact function values:'
4770 write (iout,'(2i3,50(1x,i2,f5.2))')
4771 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4772 & j=1,num_cont_hb(i))
4775 C Caution! Following code assumes that electrostatic interactions concerning
4776 C a given atom are split among at most two processors!
4786 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4789 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4790 if (MyRank.gt.0) then
4791 C Send correlation contributions to the preceding processor
4793 nn=num_cont_hb(iatel_s)
4794 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4795 cd write (iout,*) 'The BUFFER array:'
4797 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4799 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4801 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4802 C Clear the contacts of the atom passed to the neighboring processor
4803 nn=num_cont_hb(iatel_s+1)
4805 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4807 num_cont_hb(iatel_s)=0
4809 cd write (iout,*) 'Processor ',MyID,MyRank,
4810 cd & ' is sending correlation contribution to processor',MyID-1,
4811 cd & ' msglen=',msglen
4812 cd write (*,*) 'Processor ',MyID,MyRank,
4813 cd & ' is sending correlation contribution to processor',MyID-1,
4814 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4815 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4816 cd write (iout,*) 'Processor ',MyID,
4817 cd & ' has sent correlation contribution to processor',MyID-1,
4818 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4819 cd write (*,*) 'Processor ',MyID,
4820 cd & ' has sent correlation contribution to processor',MyID-1,
4821 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4823 endif ! (MyRank.gt.0)
4827 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4828 if (MyRank.lt.fgProcs-1) then
4829 C Receive correlation contributions from the next processor
4831 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4832 cd write (iout,*) 'Processor',MyID,
4833 cd & ' is receiving correlation contribution from processor',MyID+1,
4834 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4835 cd write (*,*) 'Processor',MyID,
4836 cd & ' is receiving correlation contribution from processor',MyID+1,
4837 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4839 do while (nbytes.le.0)
4840 call mp_probe(MyID+1,CorrelType,nbytes)
4842 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4843 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4844 cd write (iout,*) 'Processor',MyID,
4845 cd & ' has received correlation contribution from processor',MyID+1,
4846 cd & ' msglen=',msglen,' nbytes=',nbytes
4847 cd write (iout,*) 'The received BUFFER array:'
4849 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4851 if (msglen.eq.msglen1) then
4852 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4853 else if (msglen.eq.msglen2) then
4854 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4855 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4858 & 'ERROR!!!! message length changed while processing correlations.'
4860 & 'ERROR!!!! message length changed while processing correlations.'
4861 call mp_stopall(Error)
4862 endif ! msglen.eq.msglen1
4863 endif ! MyRank.lt.fgProcs-1
4870 write (iout,'(a)') 'Contact function values:'
4872 write (iout,'(2i3,50(1x,i2,f5.2))')
4873 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4874 & j=1,num_cont_hb(i))
4878 C Remove the loop below after debugging !!!
4885 C Calculate the local-electrostatic correlation terms
4886 do i=iatel_s,iatel_e+1
4888 num_conti=num_cont_hb(i)
4889 num_conti1=num_cont_hb(i+1)
4894 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4895 c & ' jj=',jj,' kk=',kk
4896 if (j1.eq.j+1 .or. j1.eq.j-1) then
4897 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4898 C The system gains extra energy.
4899 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4901 else if (j1.eq.j) then
4902 C Contacts I-J and I-(J+1) occur simultaneously.
4903 C The system loses extra energy.
4904 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4909 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4910 c & ' jj=',jj,' kk=',kk
4912 C Contacts I-J and (I+1)-J occur simultaneously.
4913 C The system loses extra energy.
4914 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4921 c------------------------------------------------------------------------------
4922 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4924 C This subroutine calculates multi-body contributions to hydrogen-bonding
4925 implicit real*8 (a-h,o-z)
4926 include 'DIMENSIONS'
4927 include 'DIMENSIONS.ZSCOPT'
4928 include 'COMMON.IOUNITS'
4930 include 'COMMON.INFO'
4932 include 'COMMON.FFIELD'
4933 include 'COMMON.DERIV'
4934 include 'COMMON.INTERACT'
4935 include 'COMMON.CONTACTS'
4937 parameter (max_cont=maxconts)
4938 parameter (max_dim=2*(8*3+2))
4939 parameter (msglen1=max_cont*max_dim*4)
4940 parameter (msglen2=2*msglen1)
4941 integer source,CorrelType,CorrelID,Error
4942 double precision buffer(max_cont,max_dim)
4944 double precision gx(3),gx1(3)
4947 C Set lprn=.true. for debugging
4953 if (fgProcs.le.1) goto 30
4955 write (iout,'(a)') 'Contact function values:'
4957 write (iout,'(2i3,50(1x,i2,f5.2))')
4958 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4959 & j=1,num_cont_hb(i))
4962 C Caution! Following code assumes that electrostatic interactions concerning
4963 C a given atom are split among at most two processors!
4973 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4976 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4977 if (MyRank.gt.0) then
4978 C Send correlation contributions to the preceding processor
4980 nn=num_cont_hb(iatel_s)
4981 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4982 cd write (iout,*) 'The BUFFER array:'
4984 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4986 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4988 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4989 C Clear the contacts of the atom passed to the neighboring processor
4990 nn=num_cont_hb(iatel_s+1)
4992 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4994 num_cont_hb(iatel_s)=0
4996 cd write (iout,*) 'Processor ',MyID,MyRank,
4997 cd & ' is sending correlation contribution to processor',MyID-1,
4998 cd & ' msglen=',msglen
4999 cd write (*,*) 'Processor ',MyID,MyRank,
5000 cd & ' is sending correlation contribution to processor',MyID-1,
5001 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5002 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5003 cd write (iout,*) 'Processor ',MyID,
5004 cd & ' has sent correlation contribution to processor',MyID-1,
5005 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5006 cd write (*,*) 'Processor ',MyID,
5007 cd & ' has sent correlation contribution to processor',MyID-1,
5008 cd & ' msglen=',msglen,' CorrelID=',CorrelID
5010 endif ! (MyRank.gt.0)
5014 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5015 if (MyRank.lt.fgProcs-1) then
5016 C Receive correlation contributions from the next processor
5018 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5019 cd write (iout,*) 'Processor',MyID,
5020 cd & ' is receiving correlation contribution from processor',MyID+1,
5021 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5022 cd write (*,*) 'Processor',MyID,
5023 cd & ' is receiving correlation contribution from processor',MyID+1,
5024 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5026 do while (nbytes.le.0)
5027 call mp_probe(MyID+1,CorrelType,nbytes)
5029 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5030 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
5031 cd write (iout,*) 'Processor',MyID,
5032 cd & ' has received correlation contribution from processor',MyID+1,
5033 cd & ' msglen=',msglen,' nbytes=',nbytes
5034 cd write (iout,*) 'The received BUFFER array:'
5036 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5038 if (msglen.eq.msglen1) then
5039 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5040 else if (msglen.eq.msglen2) then
5041 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5042 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
5045 & 'ERROR!!!! message length changed while processing correlations.'
5047 & 'ERROR!!!! message length changed while processing correlations.'
5048 call mp_stopall(Error)
5049 endif ! msglen.eq.msglen1
5050 endif ! MyRank.lt.fgProcs-1
5057 write (iout,'(a)') 'Contact function values:'
5059 write (iout,'(2i3,50(1x,i2,f5.2))')
5060 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5061 & j=1,num_cont_hb(i))
5067 C Remove the loop below after debugging !!!
5074 C Calculate the dipole-dipole interaction energies
5075 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5076 do i=iatel_s,iatel_e+1
5077 num_conti=num_cont_hb(i)
5084 C Calculate the local-electrostatic correlation terms
5085 do i=iatel_s,iatel_e+1
5087 num_conti=num_cont_hb(i)
5088 num_conti1=num_cont_hb(i+1)
5093 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5094 c & ' jj=',jj,' kk=',kk
5095 if (j1.eq.j+1 .or. j1.eq.j-1) then
5096 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5097 C The system gains extra energy.
5099 sqd1=dsqrt(d_cont(jj,i))
5100 sqd2=dsqrt(d_cont(kk,i1))
5101 sred_geom = sqd1*sqd2
5102 IF (sred_geom.lt.cutoff_corr) THEN
5103 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5105 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5106 c & ' jj=',jj,' kk=',kk
5107 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5108 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5110 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5111 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5114 cd write (iout,*) 'sred_geom=',sred_geom,
5115 cd & ' ekont=',ekont,' fprim=',fprimcont
5116 call calc_eello(i,j,i+1,j1,jj,kk)
5117 if (wcorr4.gt.0.0d0)
5118 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5119 if (wcorr5.gt.0.0d0)
5120 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5121 c print *,"wcorr5",ecorr5
5122 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5123 cd write(2,*)'ijkl',i,j,i+1,j1
5124 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5125 & .or. wturn6.eq.0.0d0))then
5126 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5127 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5128 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5129 cd & 'ecorr6=',ecorr6
5130 cd write (iout,'(4e15.5)') sred_geom,
5131 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5132 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5133 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5134 else if (wturn6.gt.0.0d0
5135 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5136 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5137 eturn6=eturn6+eello_turn6(i,jj,kk)
5138 cd write (2,*) 'multibody_eello:eturn6',eturn6
5142 else if (j1.eq.j) then
5143 C Contacts I-J and I-(J+1) occur simultaneously.
5144 C The system loses extra energy.
5145 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5150 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5151 c & ' jj=',jj,' kk=',kk
5153 C Contacts I-J and (I+1)-J occur simultaneously.
5154 C The system loses extra energy.
5155 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5162 c------------------------------------------------------------------------------
5163 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5164 implicit real*8 (a-h,o-z)
5165 include 'DIMENSIONS'
5166 include 'COMMON.IOUNITS'
5167 include 'COMMON.DERIV'
5168 include 'COMMON.INTERACT'
5169 include 'COMMON.CONTACTS'
5170 double precision gx(3),gx1(3)
5180 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5181 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5182 C Following 4 lines for diagnostics.
5187 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5189 c write (iout,*)'Contacts have occurred for peptide groups',
5190 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5191 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5192 C Calculate the multi-body contribution to energy.
5193 ecorr=ecorr+ekont*ees
5195 C Calculate multi-body contributions to the gradient.
5197 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5198 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5199 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5200 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5201 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5202 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5203 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5204 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5205 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5206 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5207 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5208 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5209 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5210 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5214 gradcorr(ll,m)=gradcorr(ll,m)+
5215 & ees*ekl*gacont_hbr(ll,jj,i)-
5216 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5217 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5222 gradcorr(ll,m)=gradcorr(ll,m)+
5223 & ees*eij*gacont_hbr(ll,kk,k)-
5224 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5225 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5232 C---------------------------------------------------------------------------
5233 subroutine dipole(i,j,jj)
5234 implicit real*8 (a-h,o-z)
5235 include 'DIMENSIONS'
5236 include 'DIMENSIONS.ZSCOPT'
5237 include 'COMMON.IOUNITS'
5238 include 'COMMON.CHAIN'
5239 include 'COMMON.FFIELD'
5240 include 'COMMON.DERIV'
5241 include 'COMMON.INTERACT'
5242 include 'COMMON.CONTACTS'
5243 include 'COMMON.TORSION'
5244 include 'COMMON.VAR'
5245 include 'COMMON.GEO'
5246 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5248 iti1 = itortyp(itype(i+1))
5249 if (j.lt.nres-1) then
5250 if (itype(j).le.ntyp) then
5251 itj1 = itortyp(itype(j+1))
5259 dipi(iii,1)=Ub2(iii,i)
5260 dipderi(iii)=Ub2der(iii,i)
5261 dipi(iii,2)=b1(iii,iti1)
5262 dipj(iii,1)=Ub2(iii,j)
5263 dipderj(iii)=Ub2der(iii,j)
5264 dipj(iii,2)=b1(iii,itj1)
5268 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5271 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5274 if (.not.calc_grad) return
5279 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5283 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5288 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5289 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5291 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5293 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5295 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5299 C---------------------------------------------------------------------------
5300 subroutine calc_eello(i,j,k,l,jj,kk)
5302 C This subroutine computes matrices and vectors needed to calculate
5303 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5305 implicit real*8 (a-h,o-z)
5306 include 'DIMENSIONS'
5307 include 'DIMENSIONS.ZSCOPT'
5308 include 'COMMON.IOUNITS'
5309 include 'COMMON.CHAIN'
5310 include 'COMMON.DERIV'
5311 include 'COMMON.INTERACT'
5312 include 'COMMON.CONTACTS'
5313 include 'COMMON.TORSION'
5314 include 'COMMON.VAR'
5315 include 'COMMON.GEO'
5316 include 'COMMON.FFIELD'
5317 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5318 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5321 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5322 cd & ' jj=',jj,' kk=',kk
5323 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5326 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5327 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5330 call transpose2(aa1(1,1),aa1t(1,1))
5331 call transpose2(aa2(1,1),aa2t(1,1))
5334 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5335 & aa1tder(1,1,lll,kkk))
5336 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5337 & aa2tder(1,1,lll,kkk))
5341 C parallel orientation of the two CA-CA-CA frames.
5342 if (i.gt.1 .and. itype(i).le.ntyp) then
5343 iti=itortyp(itype(i))
5347 itk1=itortyp(itype(k+1))
5348 itj=itortyp(itype(j))
5349 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
5350 itl1=itortyp(itype(l+1))
5354 C A1 kernel(j+1) A2T
5356 cd write (iout,'(3f10.5,5x,3f10.5)')
5357 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5359 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5360 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5361 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5362 C Following matrices are needed only for 6-th order cumulants
5363 IF (wcorr6.gt.0.0d0) THEN
5364 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5365 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5366 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5367 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5368 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5369 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5370 & ADtEAderx(1,1,1,1,1,1))
5372 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5373 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5374 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5375 & ADtEA1derx(1,1,1,1,1,1))
5377 C End 6-th order cumulants
5380 cd write (2,*) 'In calc_eello6'
5382 cd write (2,*) 'iii=',iii
5384 cd write (2,*) 'kkk=',kkk
5386 cd write (2,'(3(2f10.5),5x)')
5387 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5392 call transpose2(EUgder(1,1,k),auxmat(1,1))
5393 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5394 call transpose2(EUg(1,1,k),auxmat(1,1))
5395 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5396 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5400 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5401 & EAEAderx(1,1,lll,kkk,iii,1))
5405 C A1T kernel(i+1) A2
5406 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5407 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5408 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5409 C Following matrices are needed only for 6-th order cumulants
5410 IF (wcorr6.gt.0.0d0) THEN
5411 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5412 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5413 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5414 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5415 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5416 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5417 & ADtEAderx(1,1,1,1,1,2))
5418 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5419 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5420 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5421 & ADtEA1derx(1,1,1,1,1,2))
5423 C End 6-th order cumulants
5424 call transpose2(EUgder(1,1,l),auxmat(1,1))
5425 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5426 call transpose2(EUg(1,1,l),auxmat(1,1))
5427 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5428 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5432 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5433 & EAEAderx(1,1,lll,kkk,iii,2))
5438 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5439 C They are needed only when the fifth- or the sixth-order cumulants are
5441 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5442 call transpose2(AEA(1,1,1),auxmat(1,1))
5443 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5444 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5445 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5446 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5447 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5448 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5449 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5450 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5451 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5452 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5453 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5454 call transpose2(AEA(1,1,2),auxmat(1,1))
5455 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5456 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5457 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5458 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5459 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5460 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5461 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5462 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5463 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5464 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5465 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5466 C Calculate the Cartesian derivatives of the vectors.
5470 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5471 call matvec2(auxmat(1,1),b1(1,iti),
5472 & AEAb1derx(1,lll,kkk,iii,1,1))
5473 call matvec2(auxmat(1,1),Ub2(1,i),
5474 & AEAb2derx(1,lll,kkk,iii,1,1))
5475 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5476 & AEAb1derx(1,lll,kkk,iii,2,1))
5477 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5478 & AEAb2derx(1,lll,kkk,iii,2,1))
5479 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5480 call matvec2(auxmat(1,1),b1(1,itj),
5481 & AEAb1derx(1,lll,kkk,iii,1,2))
5482 call matvec2(auxmat(1,1),Ub2(1,j),
5483 & AEAb2derx(1,lll,kkk,iii,1,2))
5484 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5485 & AEAb1derx(1,lll,kkk,iii,2,2))
5486 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5487 & AEAb2derx(1,lll,kkk,iii,2,2))
5494 C Antiparallel orientation of the two CA-CA-CA frames.
5495 if (i.gt.1 .and. itype(i).le.ntyp) then
5496 iti=itortyp(itype(i))
5500 itk1=itortyp(itype(k+1))
5501 itl=itortyp(itype(l))
5502 itj=itortyp(itype(j))
5503 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
5504 itj1=itortyp(itype(j+1))
5508 C A2 kernel(j-1)T A1T
5509 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5510 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5511 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5512 C Following matrices are needed only for 6-th order cumulants
5513 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5514 & j.eq.i+4 .and. l.eq.i+3)) THEN
5515 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5516 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5517 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5518 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5519 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5520 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5521 & ADtEAderx(1,1,1,1,1,1))
5522 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5523 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5524 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5525 & ADtEA1derx(1,1,1,1,1,1))
5527 C End 6-th order cumulants
5528 call transpose2(EUgder(1,1,k),auxmat(1,1))
5529 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5530 call transpose2(EUg(1,1,k),auxmat(1,1))
5531 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5532 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5536 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5537 & EAEAderx(1,1,lll,kkk,iii,1))
5541 C A2T kernel(i+1)T A1
5542 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5543 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5544 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5545 C Following matrices are needed only for 6-th order cumulants
5546 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5547 & j.eq.i+4 .and. l.eq.i+3)) THEN
5548 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5549 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5550 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5551 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5552 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5553 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5554 & ADtEAderx(1,1,1,1,1,2))
5555 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5556 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5557 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5558 & ADtEA1derx(1,1,1,1,1,2))
5560 C End 6-th order cumulants
5561 call transpose2(EUgder(1,1,j),auxmat(1,1))
5562 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5563 call transpose2(EUg(1,1,j),auxmat(1,1))
5564 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5565 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5569 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5570 & EAEAderx(1,1,lll,kkk,iii,2))
5575 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5576 C They are needed only when the fifth- or the sixth-order cumulants are
5578 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5579 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5580 call transpose2(AEA(1,1,1),auxmat(1,1))
5581 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5582 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5583 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5584 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5585 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5586 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5587 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5588 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5589 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5590 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5591 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5592 call transpose2(AEA(1,1,2),auxmat(1,1))
5593 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5594 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5595 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5596 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5597 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5598 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5599 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5600 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5601 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5602 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5603 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5604 C Calculate the Cartesian derivatives of the vectors.
5608 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5609 call matvec2(auxmat(1,1),b1(1,iti),
5610 & AEAb1derx(1,lll,kkk,iii,1,1))
5611 call matvec2(auxmat(1,1),Ub2(1,i),
5612 & AEAb2derx(1,lll,kkk,iii,1,1))
5613 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5614 & AEAb1derx(1,lll,kkk,iii,2,1))
5615 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5616 & AEAb2derx(1,lll,kkk,iii,2,1))
5617 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5618 call matvec2(auxmat(1,1),b1(1,itl),
5619 & AEAb1derx(1,lll,kkk,iii,1,2))
5620 call matvec2(auxmat(1,1),Ub2(1,l),
5621 & AEAb2derx(1,lll,kkk,iii,1,2))
5622 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5623 & AEAb1derx(1,lll,kkk,iii,2,2))
5624 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5625 & AEAb2derx(1,lll,kkk,iii,2,2))
5634 C---------------------------------------------------------------------------
5635 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5636 & KK,KKderg,AKA,AKAderg,AKAderx)
5640 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5641 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5642 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5647 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5649 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5652 cd if (lprn) write (2,*) 'In kernel'
5654 cd if (lprn) write (2,*) 'kkk=',kkk
5656 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5657 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5659 cd write (2,*) 'lll=',lll
5660 cd write (2,*) 'iii=1'
5662 cd write (2,'(3(2f10.5),5x)')
5663 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5666 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5667 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5669 cd write (2,*) 'lll=',lll
5670 cd write (2,*) 'iii=2'
5672 cd write (2,'(3(2f10.5),5x)')
5673 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5680 C---------------------------------------------------------------------------
5681 double precision function eello4(i,j,k,l,jj,kk)
5682 implicit real*8 (a-h,o-z)
5683 include 'DIMENSIONS'
5684 include 'DIMENSIONS.ZSCOPT'
5685 include 'COMMON.IOUNITS'
5686 include 'COMMON.CHAIN'
5687 include 'COMMON.DERIV'
5688 include 'COMMON.INTERACT'
5689 include 'COMMON.CONTACTS'
5690 include 'COMMON.TORSION'
5691 include 'COMMON.VAR'
5692 include 'COMMON.GEO'
5693 double precision pizda(2,2),ggg1(3),ggg2(3)
5694 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5698 cd print *,'eello4:',i,j,k,l,jj,kk
5699 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5700 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5701 cold eij=facont_hb(jj,i)
5702 cold ekl=facont_hb(kk,k)
5704 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5706 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5707 gcorr_loc(k-1)=gcorr_loc(k-1)
5708 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5710 gcorr_loc(l-1)=gcorr_loc(l-1)
5711 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5713 gcorr_loc(j-1)=gcorr_loc(j-1)
5714 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5719 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5720 & -EAEAderx(2,2,lll,kkk,iii,1)
5721 cd derx(lll,kkk,iii)=0.0d0
5725 cd gcorr_loc(l-1)=0.0d0
5726 cd gcorr_loc(j-1)=0.0d0
5727 cd gcorr_loc(k-1)=0.0d0
5729 cd write (iout,*)'Contacts have occurred for peptide groups',
5730 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5731 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5732 if (j.lt.nres-1) then
5739 if (l.lt.nres-1) then
5747 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5748 ggg1(ll)=eel4*g_contij(ll,1)
5749 ggg2(ll)=eel4*g_contij(ll,2)
5750 ghalf=0.5d0*ggg1(ll)
5752 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5753 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5754 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5755 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5756 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5757 ghalf=0.5d0*ggg2(ll)
5759 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5760 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5761 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5762 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5767 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5768 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5773 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5774 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5780 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5785 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5789 cd write (2,*) iii,gcorr_loc(iii)
5793 cd write (2,*) 'ekont',ekont
5794 cd write (iout,*) 'eello4',ekont*eel4
5797 C---------------------------------------------------------------------------
5798 double precision function eello5(i,j,k,l,jj,kk)
5799 implicit real*8 (a-h,o-z)
5800 include 'DIMENSIONS'
5801 include 'DIMENSIONS.ZSCOPT'
5802 include 'COMMON.IOUNITS'
5803 include 'COMMON.CHAIN'
5804 include 'COMMON.DERIV'
5805 include 'COMMON.INTERACT'
5806 include 'COMMON.CONTACTS'
5807 include 'COMMON.TORSION'
5808 include 'COMMON.VAR'
5809 include 'COMMON.GEO'
5810 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5811 double precision ggg1(3),ggg2(3)
5812 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5817 C /l\ / \ \ / \ / \ / C
5818 C / \ / \ \ / \ / \ / C
5819 C j| o |l1 | o | o| o | | o |o C
5820 C \ |/k\| |/ \| / |/ \| |/ \| C
5821 C \i/ \ / \ / / \ / \ C
5823 C (I) (II) (III) (IV) C
5825 C eello5_1 eello5_2 eello5_3 eello5_4 C
5827 C Antiparallel chains C
5830 C /j\ / \ \ / \ / \ / C
5831 C / \ / \ \ / \ / \ / C
5832 C j1| o |l | o | o| o | | o |o C
5833 C \ |/k\| |/ \| / |/ \| |/ \| C
5834 C \i/ \ / \ / / \ / \ C
5836 C (I) (II) (III) (IV) C
5838 C eello5_1 eello5_2 eello5_3 eello5_4 C
5840 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5842 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5843 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5848 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5850 itk=itortyp(itype(k))
5851 itl=itortyp(itype(l))
5852 itj=itortyp(itype(j))
5857 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5858 cd & eel5_3_num,eel5_4_num)
5862 derx(lll,kkk,iii)=0.0d0
5866 cd eij=facont_hb(jj,i)
5867 cd ekl=facont_hb(kk,k)
5869 cd write (iout,*)'Contacts have occurred for peptide groups',
5870 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5872 C Contribution from the graph I.
5873 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5874 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5875 call transpose2(EUg(1,1,k),auxmat(1,1))
5876 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5877 vv(1)=pizda(1,1)-pizda(2,2)
5878 vv(2)=pizda(1,2)+pizda(2,1)
5879 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5880 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5882 C Explicit gradient in virtual-dihedral angles.
5883 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5884 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5885 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5886 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5887 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5888 vv(1)=pizda(1,1)-pizda(2,2)
5889 vv(2)=pizda(1,2)+pizda(2,1)
5890 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5891 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5892 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5893 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5894 vv(1)=pizda(1,1)-pizda(2,2)
5895 vv(2)=pizda(1,2)+pizda(2,1)
5897 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5898 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5899 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5901 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5902 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5903 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5905 C Cartesian gradient
5909 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5911 vv(1)=pizda(1,1)-pizda(2,2)
5912 vv(2)=pizda(1,2)+pizda(2,1)
5913 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5914 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5915 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5922 C Contribution from graph II
5923 call transpose2(EE(1,1,itk),auxmat(1,1))
5924 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5925 vv(1)=pizda(1,1)+pizda(2,2)
5926 vv(2)=pizda(2,1)-pizda(1,2)
5927 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5928 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5930 C Explicit gradient in virtual-dihedral angles.
5931 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5932 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5933 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5934 vv(1)=pizda(1,1)+pizda(2,2)
5935 vv(2)=pizda(2,1)-pizda(1,2)
5937 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5938 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5939 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5941 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5942 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5943 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5945 C Cartesian gradient
5949 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5951 vv(1)=pizda(1,1)+pizda(2,2)
5952 vv(2)=pizda(2,1)-pizda(1,2)
5953 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5954 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5955 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5964 C Parallel orientation
5965 C Contribution from graph III
5966 call transpose2(EUg(1,1,l),auxmat(1,1))
5967 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5968 vv(1)=pizda(1,1)-pizda(2,2)
5969 vv(2)=pizda(1,2)+pizda(2,1)
5970 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5971 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5973 C Explicit gradient in virtual-dihedral angles.
5974 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5975 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5976 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5977 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5978 vv(1)=pizda(1,1)-pizda(2,2)
5979 vv(2)=pizda(1,2)+pizda(2,1)
5980 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5981 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5982 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5983 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5984 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5985 vv(1)=pizda(1,1)-pizda(2,2)
5986 vv(2)=pizda(1,2)+pizda(2,1)
5987 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5988 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5989 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5990 C Cartesian gradient
5994 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5996 vv(1)=pizda(1,1)-pizda(2,2)
5997 vv(2)=pizda(1,2)+pizda(2,1)
5998 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5999 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6000 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6006 C Contribution from graph IV
6008 call transpose2(EE(1,1,itl),auxmat(1,1))
6009 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6010 vv(1)=pizda(1,1)+pizda(2,2)
6011 vv(2)=pizda(2,1)-pizda(1,2)
6012 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6013 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6015 C Explicit gradient in virtual-dihedral angles.
6016 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6017 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6018 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6019 vv(1)=pizda(1,1)+pizda(2,2)
6020 vv(2)=pizda(2,1)-pizda(1,2)
6021 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6022 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6023 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6024 C Cartesian gradient
6028 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6030 vv(1)=pizda(1,1)+pizda(2,2)
6031 vv(2)=pizda(2,1)-pizda(1,2)
6032 derx(lll,kkk,iii)=derx(lll,kkk,iii)
6033 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6034 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
6040 C Antiparallel orientation
6041 C Contribution from graph III
6043 call transpose2(EUg(1,1,j),auxmat(1,1))
6044 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6045 vv(1)=pizda(1,1)-pizda(2,2)
6046 vv(2)=pizda(1,2)+pizda(2,1)
6047 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6048 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6050 C Explicit gradient in virtual-dihedral angles.
6051 g_corr5_loc(l-1)=g_corr5_loc(l-1)
6052 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6053 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6054 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6055 vv(1)=pizda(1,1)-pizda(2,2)
6056 vv(2)=pizda(1,2)+pizda(2,1)
6057 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6058 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6059 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6060 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6061 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6062 vv(1)=pizda(1,1)-pizda(2,2)
6063 vv(2)=pizda(1,2)+pizda(2,1)
6064 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6065 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6066 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6067 C Cartesian gradient
6071 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6073 vv(1)=pizda(1,1)-pizda(2,2)
6074 vv(2)=pizda(1,2)+pizda(2,1)
6075 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6076 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6077 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6083 C Contribution from graph IV
6085 call transpose2(EE(1,1,itj),auxmat(1,1))
6086 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6087 vv(1)=pizda(1,1)+pizda(2,2)
6088 vv(2)=pizda(2,1)-pizda(1,2)
6089 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6090 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6092 C Explicit gradient in virtual-dihedral angles.
6093 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6094 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6095 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6096 vv(1)=pizda(1,1)+pizda(2,2)
6097 vv(2)=pizda(2,1)-pizda(1,2)
6098 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6099 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6100 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6101 C Cartesian gradient
6105 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6107 vv(1)=pizda(1,1)+pizda(2,2)
6108 vv(2)=pizda(2,1)-pizda(1,2)
6109 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6110 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6111 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6118 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6119 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6120 cd write (2,*) 'ijkl',i,j,k,l
6121 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6122 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6124 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6125 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6126 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6127 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6129 if (j.lt.nres-1) then
6136 if (l.lt.nres-1) then
6146 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6148 ggg1(ll)=eel5*g_contij(ll,1)
6149 ggg2(ll)=eel5*g_contij(ll,2)
6150 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6151 ghalf=0.5d0*ggg1(ll)
6153 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6154 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6155 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6156 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6157 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6158 ghalf=0.5d0*ggg2(ll)
6160 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6161 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6162 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6163 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6168 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6169 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6174 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6175 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6181 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6186 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6190 cd write (2,*) iii,g_corr5_loc(iii)
6194 cd write (2,*) 'ekont',ekont
6195 cd write (iout,*) 'eello5',ekont*eel5
6198 c--------------------------------------------------------------------------
6199 double precision function eello6(i,j,k,l,jj,kk)
6200 implicit real*8 (a-h,o-z)
6201 include 'DIMENSIONS'
6202 include 'DIMENSIONS.ZSCOPT'
6203 include 'COMMON.IOUNITS'
6204 include 'COMMON.CHAIN'
6205 include 'COMMON.DERIV'
6206 include 'COMMON.INTERACT'
6207 include 'COMMON.CONTACTS'
6208 include 'COMMON.TORSION'
6209 include 'COMMON.VAR'
6210 include 'COMMON.GEO'
6211 include 'COMMON.FFIELD'
6212 double precision ggg1(3),ggg2(3)
6213 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6218 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6226 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6227 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6231 derx(lll,kkk,iii)=0.0d0
6235 cd eij=facont_hb(jj,i)
6236 cd ekl=facont_hb(kk,k)
6242 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6243 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6244 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6245 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6246 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6247 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6249 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6250 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6251 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6252 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6253 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6254 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6258 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6260 C If turn contributions are considered, they will be handled separately.
6261 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6262 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6263 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6264 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6265 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6266 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6267 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6270 if (j.lt.nres-1) then
6277 if (l.lt.nres-1) then
6285 ggg1(ll)=eel6*g_contij(ll,1)
6286 ggg2(ll)=eel6*g_contij(ll,2)
6287 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6288 ghalf=0.5d0*ggg1(ll)
6290 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6291 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6292 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6293 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6294 ghalf=0.5d0*ggg2(ll)
6295 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6297 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6298 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6299 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6300 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6305 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6306 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6311 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6312 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6318 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6323 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6327 cd write (2,*) iii,g_corr6_loc(iii)
6331 cd write (2,*) 'ekont',ekont
6332 cd write (iout,*) 'eello6',ekont*eel6
6335 c--------------------------------------------------------------------------
6336 double precision function eello6_graph1(i,j,k,l,imat,swap)
6337 implicit real*8 (a-h,o-z)
6338 include 'DIMENSIONS'
6339 include 'DIMENSIONS.ZSCOPT'
6340 include 'COMMON.IOUNITS'
6341 include 'COMMON.CHAIN'
6342 include 'COMMON.DERIV'
6343 include 'COMMON.INTERACT'
6344 include 'COMMON.CONTACTS'
6345 include 'COMMON.TORSION'
6346 include 'COMMON.VAR'
6347 include 'COMMON.GEO'
6348 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6352 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6354 C Parallel Antiparallel C
6360 C \ j|/k\| / \ |/k\|l / C
6365 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6366 itk=itortyp(itype(k))
6367 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6368 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6369 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6370 call transpose2(EUgC(1,1,k),auxmat(1,1))
6371 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6372 vv1(1)=pizda1(1,1)-pizda1(2,2)
6373 vv1(2)=pizda1(1,2)+pizda1(2,1)
6374 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6375 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6376 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6377 s5=scalar2(vv(1),Dtobr2(1,i))
6378 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6379 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6380 if (.not. calc_grad) return
6381 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6382 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6383 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6384 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6385 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6386 & +scalar2(vv(1),Dtobr2der(1,i)))
6387 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6388 vv1(1)=pizda1(1,1)-pizda1(2,2)
6389 vv1(2)=pizda1(1,2)+pizda1(2,1)
6390 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6391 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6393 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6394 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6395 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6396 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6397 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6399 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6400 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6401 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6402 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6403 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6405 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6406 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6407 vv1(1)=pizda1(1,1)-pizda1(2,2)
6408 vv1(2)=pizda1(1,2)+pizda1(2,1)
6409 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6410 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6411 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6412 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6421 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6422 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6423 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6424 call transpose2(EUgC(1,1,k),auxmat(1,1))
6425 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6427 vv1(1)=pizda1(1,1)-pizda1(2,2)
6428 vv1(2)=pizda1(1,2)+pizda1(2,1)
6429 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6430 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6431 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6432 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6433 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6434 s5=scalar2(vv(1),Dtobr2(1,i))
6435 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6441 c----------------------------------------------------------------------------
6442 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6443 implicit real*8 (a-h,o-z)
6444 include 'DIMENSIONS'
6445 include 'DIMENSIONS.ZSCOPT'
6446 include 'COMMON.IOUNITS'
6447 include 'COMMON.CHAIN'
6448 include 'COMMON.DERIV'
6449 include 'COMMON.INTERACT'
6450 include 'COMMON.CONTACTS'
6451 include 'COMMON.TORSION'
6452 include 'COMMON.VAR'
6453 include 'COMMON.GEO'
6455 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6456 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6459 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6461 C Parallel Antiparallel C
6467 C \ j|/k\| \ |/k\|l C
6472 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6473 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6474 C AL 7/4/01 s1 would occur in the sixth-order moment,
6475 C but not in a cluster cumulant
6477 s1=dip(1,jj,i)*dip(1,kk,k)
6479 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6480 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6481 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6482 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6483 call transpose2(EUg(1,1,k),auxmat(1,1))
6484 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6485 vv(1)=pizda(1,1)-pizda(2,2)
6486 vv(2)=pizda(1,2)+pizda(2,1)
6487 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6488 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6490 eello6_graph2=-(s1+s2+s3+s4)
6492 eello6_graph2=-(s2+s3+s4)
6495 if (.not. calc_grad) return
6496 C Derivatives in gamma(i-1)
6499 s1=dipderg(1,jj,i)*dip(1,kk,k)
6501 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6502 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6503 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6504 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6506 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6508 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6510 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6512 C Derivatives in gamma(k-1)
6514 s1=dip(1,jj,i)*dipderg(1,kk,k)
6516 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6517 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6518 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6519 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6520 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6521 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6522 vv(1)=pizda(1,1)-pizda(2,2)
6523 vv(2)=pizda(1,2)+pizda(2,1)
6524 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6526 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6528 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6530 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6531 C Derivatives in gamma(j-1) or gamma(l-1)
6534 s1=dipderg(3,jj,i)*dip(1,kk,k)
6536 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6537 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6538 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6539 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6540 vv(1)=pizda(1,1)-pizda(2,2)
6541 vv(2)=pizda(1,2)+pizda(2,1)
6542 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6545 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6547 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6550 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6551 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6553 C Derivatives in gamma(l-1) or gamma(j-1)
6556 s1=dip(1,jj,i)*dipderg(3,kk,k)
6558 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6559 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6560 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6561 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6562 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6563 vv(1)=pizda(1,1)-pizda(2,2)
6564 vv(2)=pizda(1,2)+pizda(2,1)
6565 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6568 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6570 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6573 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6574 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6576 C Cartesian derivatives.
6578 write (2,*) 'In eello6_graph2'
6580 write (2,*) 'iii=',iii
6582 write (2,*) 'kkk=',kkk
6584 write (2,'(3(2f10.5),5x)')
6585 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6595 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6597 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6600 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6602 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6603 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6605 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6606 call transpose2(EUg(1,1,k),auxmat(1,1))
6607 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6609 vv(1)=pizda(1,1)-pizda(2,2)
6610 vv(2)=pizda(1,2)+pizda(2,1)
6611 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6612 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6614 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6616 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6619 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6621 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6628 c----------------------------------------------------------------------------
6629 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6630 implicit real*8 (a-h,o-z)
6631 include 'DIMENSIONS'
6632 include 'DIMENSIONS.ZSCOPT'
6633 include 'COMMON.IOUNITS'
6634 include 'COMMON.CHAIN'
6635 include 'COMMON.DERIV'
6636 include 'COMMON.INTERACT'
6637 include 'COMMON.CONTACTS'
6638 include 'COMMON.TORSION'
6639 include 'COMMON.VAR'
6640 include 'COMMON.GEO'
6641 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6643 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6645 C Parallel Antiparallel C
6651 C j|/k\| / |/k\|l / C
6656 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6658 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6659 C energy moment and not to the cluster cumulant.
6660 iti=itortyp(itype(i))
6661 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6662 itj1=itortyp(itype(j+1))
6666 itk=itortyp(itype(k))
6667 itk1=itortyp(itype(k+1))
6668 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6669 itl1=itortyp(itype(l+1))
6674 s1=dip(4,jj,i)*dip(4,kk,k)
6676 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6677 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6678 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6679 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6680 call transpose2(EE(1,1,itk),auxmat(1,1))
6681 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6682 vv(1)=pizda(1,1)+pizda(2,2)
6683 vv(2)=pizda(2,1)-pizda(1,2)
6684 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6685 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6687 eello6_graph3=-(s1+s2+s3+s4)
6689 eello6_graph3=-(s2+s3+s4)
6692 if (.not. calc_grad) return
6693 C Derivatives in gamma(k-1)
6694 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6695 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6696 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6697 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6698 C Derivatives in gamma(l-1)
6699 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6700 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6701 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6702 vv(1)=pizda(1,1)+pizda(2,2)
6703 vv(2)=pizda(2,1)-pizda(1,2)
6704 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6705 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6706 C Cartesian derivatives.
6712 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6714 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6717 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6719 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6720 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6722 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6723 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6725 vv(1)=pizda(1,1)+pizda(2,2)
6726 vv(2)=pizda(2,1)-pizda(1,2)
6727 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6729 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6731 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6734 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6736 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6738 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6744 c----------------------------------------------------------------------------
6745 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6746 implicit real*8 (a-h,o-z)
6747 include 'DIMENSIONS'
6748 include 'DIMENSIONS.ZSCOPT'
6749 include 'COMMON.IOUNITS'
6750 include 'COMMON.CHAIN'
6751 include 'COMMON.DERIV'
6752 include 'COMMON.INTERACT'
6753 include 'COMMON.CONTACTS'
6754 include 'COMMON.TORSION'
6755 include 'COMMON.VAR'
6756 include 'COMMON.GEO'
6757 include 'COMMON.FFIELD'
6758 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6759 & auxvec1(2),auxmat1(2,2)
6761 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6763 C Parallel Antiparallel C
6769 C \ j|/k\| \ |/k\|l C
6774 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6776 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6777 C energy moment and not to the cluster cumulant.
6778 cd write (2,*) 'eello_graph4: wturn6',wturn6
6779 iti=itortyp(itype(i))
6780 itj=itortyp(itype(j))
6781 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6782 itj1=itortyp(itype(j+1))
6786 itk=itortyp(itype(k))
6787 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
6788 itk1=itortyp(itype(k+1))
6792 itl=itortyp(itype(l))
6793 if (l.lt.nres-1) then
6794 itl1=itortyp(itype(l+1))
6798 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6799 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6800 cd & ' itl',itl,' itl1',itl1
6803 s1=dip(3,jj,i)*dip(3,kk,k)
6805 s1=dip(2,jj,j)*dip(2,kk,l)
6808 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6809 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6811 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6812 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6814 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6815 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6817 call transpose2(EUg(1,1,k),auxmat(1,1))
6818 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6819 vv(1)=pizda(1,1)-pizda(2,2)
6820 vv(2)=pizda(2,1)+pizda(1,2)
6821 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6822 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6824 eello6_graph4=-(s1+s2+s3+s4)
6826 eello6_graph4=-(s2+s3+s4)
6828 if (.not. calc_grad) return
6829 C Derivatives in gamma(i-1)
6833 s1=dipderg(2,jj,i)*dip(3,kk,k)
6835 s1=dipderg(4,jj,j)*dip(2,kk,l)
6838 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6840 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6841 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6843 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6844 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6846 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6847 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6848 cd write (2,*) 'turn6 derivatives'
6850 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6852 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6856 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6858 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6862 C Derivatives in gamma(k-1)
6865 s1=dip(3,jj,i)*dipderg(2,kk,k)
6867 s1=dip(2,jj,j)*dipderg(4,kk,l)
6870 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6871 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6873 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6874 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6876 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6877 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6879 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6880 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6881 vv(1)=pizda(1,1)-pizda(2,2)
6882 vv(2)=pizda(2,1)+pizda(1,2)
6883 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6884 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6886 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6888 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6892 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6894 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6897 C Derivatives in gamma(j-1) or gamma(l-1)
6898 if (l.eq.j+1 .and. l.gt.1) then
6899 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6900 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6901 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6902 vv(1)=pizda(1,1)-pizda(2,2)
6903 vv(2)=pizda(2,1)+pizda(1,2)
6904 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6905 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6906 else if (j.gt.1) then
6907 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6908 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6909 call matmat2(AECAderg(1,1,imat),auxmat(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),Dtobr2(1,i))
6913 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6914 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6916 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6919 C Cartesian derivatives.
6926 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6928 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6932 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6934 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6938 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6940 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6942 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6943 & b1(1,itj1),auxvec(1))
6944 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6946 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6947 & b1(1,itl1),auxvec(1))
6948 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6950 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6952 vv(1)=pizda(1,1)-pizda(2,2)
6953 vv(2)=pizda(2,1)+pizda(1,2)
6954 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6956 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6958 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6961 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6964 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6967 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6969 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6971 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6975 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6977 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6980 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6982 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6990 c----------------------------------------------------------------------------
6991 double precision function eello_turn6(i,jj,kk)
6992 implicit real*8 (a-h,o-z)
6993 include 'DIMENSIONS'
6994 include 'DIMENSIONS.ZSCOPT'
6995 include 'COMMON.IOUNITS'
6996 include 'COMMON.CHAIN'
6997 include 'COMMON.DERIV'
6998 include 'COMMON.INTERACT'
6999 include 'COMMON.CONTACTS'
7000 include 'COMMON.TORSION'
7001 include 'COMMON.VAR'
7002 include 'COMMON.GEO'
7003 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7004 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7006 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7007 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7008 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7009 C the respective energy moment and not to the cluster cumulant.
7014 iti=itortyp(itype(i))
7015 itk=itortyp(itype(k))
7016 itk1=itortyp(itype(k+1))
7017 itl=itortyp(itype(l))
7018 itj=itortyp(itype(j))
7019 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7020 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
7021 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7026 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7028 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
7032 derx_turn(lll,kkk,iii)=0.0d0
7039 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7041 cd write (2,*) 'eello6_5',eello6_5
7043 call transpose2(AEA(1,1,1),auxmat(1,1))
7044 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7045 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7046 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7050 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7051 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7052 s2 = scalar2(b1(1,itk),vtemp1(1))
7054 call transpose2(AEA(1,1,2),atemp(1,1))
7055 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7056 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7057 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7061 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7062 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7063 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7065 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7066 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7067 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7068 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7069 ss13 = scalar2(b1(1,itk),vtemp4(1))
7070 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7074 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7080 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7082 C Derivatives in gamma(i+2)
7084 call transpose2(AEA(1,1,1),auxmatd(1,1))
7085 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7086 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7087 call transpose2(AEAderg(1,1,2),atempd(1,1))
7088 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7089 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7093 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7094 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7095 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7101 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7102 C Derivatives in gamma(i+3)
7104 call transpose2(AEA(1,1,1),auxmatd(1,1))
7105 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7106 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7107 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7111 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7112 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7113 s2d = scalar2(b1(1,itk),vtemp1d(1))
7115 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7116 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7118 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7120 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7121 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7122 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7132 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7133 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7135 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7136 & -0.5d0*ekont*(s2d+s12d)
7138 C Derivatives in gamma(i+4)
7139 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7140 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7141 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7143 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7144 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7145 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7155 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7157 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7159 C Derivatives in gamma(i+5)
7161 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7162 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7163 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7167 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7168 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7169 s2d = scalar2(b1(1,itk),vtemp1d(1))
7171 call transpose2(AEA(1,1,2),atempd(1,1))
7172 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7173 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7177 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7178 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7180 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7181 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7182 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7192 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7193 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7195 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7196 & -0.5d0*ekont*(s2d+s12d)
7198 C Cartesian derivatives
7203 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7204 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7205 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7209 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7210 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7212 s2d = scalar2(b1(1,itk),vtemp1d(1))
7214 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7215 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7216 s8d = -(atempd(1,1)+atempd(2,2))*
7217 & scalar2(cc(1,1,itl),vtemp2(1))
7221 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7223 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7224 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7231 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7234 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7238 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7239 & - 0.5d0*(s8d+s12d)
7241 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7250 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7252 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7253 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7254 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7255 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7256 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7258 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7259 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7260 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7264 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7265 cd & 16*eel_turn6_num
7267 if (j.lt.nres-1) then
7274 if (l.lt.nres-1) then
7282 ggg1(ll)=eel_turn6*g_contij(ll,1)
7283 ggg2(ll)=eel_turn6*g_contij(ll,2)
7284 ghalf=0.5d0*ggg1(ll)
7286 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7287 & +ekont*derx_turn(ll,2,1)
7288 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7289 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7290 & +ekont*derx_turn(ll,4,1)
7291 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7292 ghalf=0.5d0*ggg2(ll)
7294 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7295 & +ekont*derx_turn(ll,2,2)
7296 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7297 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7298 & +ekont*derx_turn(ll,4,2)
7299 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7304 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7309 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7315 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7320 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7324 cd write (2,*) iii,g_corr6_loc(iii)
7327 eello_turn6=ekont*eel_turn6
7328 cd write (2,*) 'ekont',ekont
7329 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7332 crc-------------------------------------------------
7333 SUBROUTINE MATVEC2(A1,V1,V2)
7334 implicit real*8 (a-h,o-z)
7335 include 'DIMENSIONS'
7336 DIMENSION A1(2,2),V1(2),V2(2)
7340 c 3 VI=VI+A1(I,K)*V1(K)
7344 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7345 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7350 C---------------------------------------
7351 SUBROUTINE MATMAT2(A1,A2,A3)
7352 implicit real*8 (a-h,o-z)
7353 include 'DIMENSIONS'
7354 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7355 c DIMENSION AI3(2,2)
7359 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7365 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7366 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7367 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7368 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7376 c-------------------------------------------------------------------------
7377 double precision function scalar2(u,v)
7379 double precision u(2),v(2)
7382 scalar2=u(1)*v(1)+u(2)*v(2)
7386 C-----------------------------------------------------------------------------
7388 subroutine transpose2(a,at)
7390 double precision a(2,2),at(2,2)
7397 c--------------------------------------------------------------------------
7398 subroutine transpose(n,a,at)
7401 double precision a(n,n),at(n,n)
7409 C---------------------------------------------------------------------------
7410 subroutine prodmat3(a1,a2,kk,transp,prod)
7413 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7415 crc double precision auxmat(2,2),prod_(2,2)
7418 crc call transpose2(kk(1,1),auxmat(1,1))
7419 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7420 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7422 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7423 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7424 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7425 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7426 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7427 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7428 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7429 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7432 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7433 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7435 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7436 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7437 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7438 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7439 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7440 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7441 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7442 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7445 c call transpose2(a2(1,1),a2t(1,1))
7448 crc print *,((prod_(i,j),i=1,2),j=1,2)
7449 crc print *,((prod(i,j),i=1,2),j=1,2)
7453 C-----------------------------------------------------------------------------
7454 double precision function scalar(u,v)
7456 double precision u(3),v(3)