1 subroutine etotal(energia)
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 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
26 cd print *,'nnt=',nnt,' nct=',nct
28 C Compute the side-chain and electrostatic interaction energy
30 goto (101,102,103,104,105,106) ipot
31 C Lennard-Jones potential.
33 cd print '(a)','Exit ELJ'
35 C Lennard-Jones-Kihara potential (shifted).
38 C Berne-Pechukas potential (dilated LJ, angular dependence).
41 C Gay-Berne potential (shifted LJ, angular dependence).
44 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 106 call emomo(evdw,evdw_p,evdw_m)
50 C Calculate electrostatic (H-bonding) energy of the main chain.
52 107 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
54 C Calculate excluded-volume interaction energy between peptide groups
57 call escp(evdw2,evdw2_14)
59 c Calculate the bond-stretching energy
62 c write (iout,*) "estr",estr
65 C Calculate the disulfide-bridge and other energy and the contributions
66 C from other distance constraints.
67 cd print *,'Calling EHPB'
69 cd print *,'EHPB exitted succesfully.'
71 C Calculate the virtual-bond-angle energy.
74 c write (iout,*)'Bend energy finished.'
77 C Calculate the SC local energy.
80 c write (iout,*)'SCLOC energy finished.'
83 C Calculate the virtual-bond torsional energy.
85 cd print *,'nterm=',nterm
86 call etor(etors,edihcnstr)
87 c write (iout,*) "After etor"
90 C 6/23/01 Calculate double-torsional energy
93 c write (iout,*) "After etor_d"
96 C 21/5/07 Calculate local sicdechain correlation energy
98 call eback_sc_corr(esccor)
99 c write (iout,*) "After eback_sccor"
102 C 12/1/95 Multi-body terms
110 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
111 & .or. wturn6.gt.0.0d0) then
112 c print *,"calling multibody_eello"
113 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
114 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
115 c print *,ecorr,ecorr5,ecorr6,eturn6
117 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
118 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
120 C call multibody(ecorr)
124 C scale large componenets
128 eello_turn3_scal=100.0
129 eello_turn4_scal=100.0
141 ecorr5=ecorr5/ecorr5_scal
142 eel_loc=eel_loc/eel_loc_scal
143 eello_turn3=eello_turn3/eello_turn3_scal
144 eello_turn4=eello_turn4/eello_turn4_scal
145 eturn6=eturn6/eturn6_scal
146 ecorr6=ecorr6/ecorr6_scal
148 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
149 & +wang*ebe+wtor*etors+wscloc*escloc
150 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
151 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
152 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
153 & +wbond*estr+wsccor*esccor
155 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
156 & +wang*ebe+wtor*etors+wscloc*escloc
157 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
158 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
159 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
160 & +wbond*estr+wsccor*esccor
165 energia(2)=evdw2-evdw2_14
182 energia(8)=eello_turn3
183 energia(9)=eello_turn4
192 energia(20)=edihcnstr
196 if (isnan(etot).ne.0) energia(0)=1.0d+99
198 if (isnan(etot)) energia(0)=1.0d+99
203 idumm=proc_proc(etot,i)
205 call proc_proc(etot,i)
207 if(i.eq.1)energia(0)=1.0d+99
214 C Sum up the components of the Cartesian gradient.
219 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
220 & welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
222 & wstrain*ghpbc(j,i)+
223 & wcorr*gradcorr(j,i)+
224 & wel_loc*gel_loc(j,i)/eel_loc_scal+
225 & wturn3*gcorr3_turn(j,i)/eello_turn3_scal+
226 & wturn4*gcorr4_turn(j,i)/eello_turn4_scal+
227 & wcorr5*gradcorr5(j,i)/ecorr5_scal+
228 & wcorr6*gradcorr6(j,i)/ecorr6_scal+
229 & wturn6*gcorr6_turn(j,i)/eturn6_scal+
230 & wsccor*gsccorc(j,i)
231 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
233 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
234 & wsccor*gsccorx(j,i)
239 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
240 & welec*gelc(j,i)+wstrain*ghpbc(j,i)+
242 & wcorr*gradcorr(j,i)+
243 & wel_loc*gel_loc(j,i)/eel_loc_scal+
244 & wturn3*gcorr3_turn(j,i)/eello_turn3_scal+
245 & wturn4*gcorr4_turn(j,i)/eello_turn4_scal+
246 & wcorr5*gradcorr5(j,i)/ecorr5_scal+
247 & wcorr6*gradcorr6(j,i)/ecorr6_scal+
248 & wturn6*gcorr6_turn(j,i)/eturn6_scal+
249 & wsccor*gsccorc(j,i)
250 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
252 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
253 & wsccor*gsccorc(j,i)
256 cd print '(i3,9(1pe12.4))',i,(gvdwc(k,i),k=1,3),(gelc(k,i),k=1,3),
257 cd & (gradc(k,i),k=1,3)
262 cd write (iout,*) i,g_corr5_loc(i)
263 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
264 & +wcorr5*g_corr5_loc(i)/ecorr5_scal
265 & +wcorr6*g_corr6_loc(i)/ecorr6_scal
266 & +wturn4*gel_loc_turn4(i)/eello_turn4_scal
267 & +wturn3*gel_loc_turn3(i)/eello_turn3_scal
268 & +wturn6*gel_loc_turn6(i)/eturn6_scal
269 & +wel_loc*gel_loc_loc(i)/eel_loc_scal
270 & +wsccor*gsccor_loc(i)
273 cd print*,evdw,wsc,evdw2,wscp,ees+evdw1,welec,ebe,wang,
274 cd & escloc,wscloc,etors,wtor,ehpb,wstrain,nss,ebr,etot
275 cd call enerprint(energia(0))
280 C------------------------------------------------------------------------
281 subroutine enerprint(energia)
282 implicit real*8 (a-h,o-z)
284 include 'DIMENSIONS.ZSCOPT'
285 include 'COMMON.IOUNITS'
286 include 'COMMON.FFIELD'
287 include 'COMMON.SBRIDGE'
288 double precision energia(0:max_ene)
292 evdw2=energia(2)+energia(18)
304 eello_turn3=energia(8)
305 eello_turn4=energia(9)
306 eello_turn6=energia(10)
312 edihcnstr=energia(20)
316 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
317 & estr,wbond,ebe,wang,
318 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
320 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
321 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,
323 10 format (/'Virtual-chain energies:'//
324 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
325 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
326 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
327 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
328 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
329 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
330 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
331 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
332 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
333 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
334 & ' (SS bridges & dist. cnstr.)'/
335 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
336 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
337 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
338 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
339 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
340 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
341 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
342 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
343 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
344 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
345 & 'ETOT= ',1pE16.6,' (total)')
347 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,estr,wbond,ebe,wang,
348 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
350 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
351 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,
353 10 format (/'Virtual-chain energies:'//
354 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
355 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
356 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
357 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
358 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
359 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
360 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
361 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
362 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
363 & ' (SS bridges & dist. cnstr.)'/
364 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
365 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
366 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
367 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
368 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
369 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
370 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
371 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
372 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
373 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
374 & 'ETOT= ',1pE16.6,' (total)')
378 C-----------------------------------------------------------------------
381 C This subroutine calculates the interaction energy of nonbonded side chains
382 C assuming the LJ potential of interaction.
384 implicit real*8 (a-h,o-z)
386 include 'DIMENSIONS.ZSCOPT'
387 parameter (accur=1.0d-10)
390 include 'COMMON.LOCAL'
391 include 'COMMON.CHAIN'
392 include 'COMMON.DERIV'
393 include 'COMMON.INTERACT'
394 include 'COMMON.TORSION'
395 include 'COMMON.WEIGHTDER'
396 include 'COMMON.SBRIDGE'
397 include 'COMMON.NAMES'
398 include 'COMMON.IOUNITS'
399 include 'COMMON.CONTACTS'
403 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
406 eneps_temp(j,i)=0.0d0
419 C Calculate SC interaction energy.
422 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
423 cd & 'iend=',iend(i,iint)
424 do j=istart(i,iint),iend(i,iint)
429 C Change 12/1/95 to calculate four-body interactions
430 rij=xj*xj+yj*yj+zj*zj
432 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
433 eps0ij=eps(itypi,itypj)
435 e1=fac*fac*aa(itypi,itypj)
436 e2=fac*bb(itypi,itypj)
438 ij=icant(itypi,itypj)
439 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
440 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
441 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
442 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
443 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
444 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
445 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
446 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
450 C Calculate the components of the gradient in DC and X
452 fac=-rrij*(e1+evdwij)
457 gvdwx(k,i)=gvdwx(k,i)-gg(k)
458 gvdwx(k,j)=gvdwx(k,j)+gg(k)
462 gvdwc(l,k)=gvdwc(l,k)+gg(l)
467 C 12/1/95, revised on 5/20/97
469 C Calculate the contact function. The ith column of the array JCONT will
470 C contain the numbers of atoms that make contacts with the atom I (of numbers
471 C greater than I). The arrays FACONT and GACONT will contain the values of
472 C the contact function and its derivative.
474 C Uncomment next line, if the correlation interactions include EVDW explicitly.
475 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
476 C Uncomment next line, if the correlation interactions are contact function only
477 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
479 sigij=sigma(itypi,itypj)
480 r0ij=rs0(itypi,itypj)
482 C Check whether the SC's are not too far to make a contact.
485 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
486 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
488 if (fcont.gt.0.0D0) then
489 C If the SC-SC distance if close to sigma, apply spline.
490 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
491 cAdam & fcont1,fprimcont1)
492 cAdam fcont1=1.0d0-fcont1
493 cAdam if (fcont1.gt.0.0d0) then
494 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
495 cAdam fcont=fcont*fcont1
497 C Uncomment following 4 lines to have the geometric average of the epsilon0's
498 cga eps0ij=1.0d0/dsqrt(eps0ij)
500 cga gg(k)=gg(k)*eps0ij
502 cga eps0ij=-evdwij*eps0ij
503 C Uncomment for AL's type of SC correlation interactions.
505 num_conti=num_conti+1
507 facont(num_conti,i)=fcont*eps0ij
508 fprimcont=eps0ij*fprimcont/rij
510 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
511 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
512 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
513 C Uncomment following 3 lines for Skolnick's type of SC correlation.
514 gacont(1,num_conti,i)=-fprimcont*xj
515 gacont(2,num_conti,i)=-fprimcont*yj
516 gacont(3,num_conti,i)=-fprimcont*zj
517 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
518 cd write (iout,'(2i3,3f10.5)')
519 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
525 num_cont(i)=num_conti
530 gvdwc(j,i)=expon*gvdwc(j,i)
531 gvdwx(j,i)=expon*gvdwx(j,i)
535 C******************************************************************************
539 C To save time, the factor of EXPON has been extracted from ALL components
540 C of GVDWC and GRADX. Remember to multiply them by this factor before further
543 C******************************************************************************
546 C-----------------------------------------------------------------------------
547 subroutine eljk(evdw)
549 C This subroutine calculates the interaction energy of nonbonded side chains
550 C assuming the LJK potential of interaction.
552 implicit real*8 (a-h,o-z)
554 include 'DIMENSIONS.ZSCOPT'
557 include 'COMMON.LOCAL'
558 include 'COMMON.CHAIN'
559 include 'COMMON.DERIV'
560 include 'COMMON.INTERACT'
561 include 'COMMON.WEIGHTDER'
562 include 'COMMON.IOUNITS'
563 include 'COMMON.NAMES'
568 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
571 eneps_temp(j,i)=0.0d0
582 C Calculate SC interaction energy.
585 do j=istart(i,iint),iend(i,iint)
590 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
592 e_augm=augm(itypi,itypj)*fac_augm
595 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
596 fac=r_shift_inv**expon
597 e1=fac*fac*aa(itypi,itypj)
598 e2=fac*bb(itypi,itypj)
600 ij=icant(itypi,itypj)
601 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
602 & /dabs(eps(itypi,itypj))
603 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
604 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
605 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
606 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
607 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
608 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
609 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
610 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
614 C Calculate the components of the gradient in DC and X
616 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
621 gvdwx(k,i)=gvdwx(k,i)-gg(k)
622 gvdwx(k,j)=gvdwx(k,j)+gg(k)
626 gvdwc(l,k)=gvdwc(l,k)+gg(l)
636 gvdwc(j,i)=expon*gvdwc(j,i)
637 gvdwx(j,i)=expon*gvdwx(j,i)
643 C-----------------------------------------------------------------------------
646 C This subroutine calculates the interaction energy of nonbonded side chains
647 C assuming the Berne-Pechukas potential of interaction.
649 implicit real*8 (a-h,o-z)
651 include 'DIMENSIONS.ZSCOPT'
654 include 'COMMON.LOCAL'
655 include 'COMMON.CHAIN'
656 include 'COMMON.DERIV'
657 include 'COMMON.NAMES'
658 include 'COMMON.INTERACT'
659 include 'COMMON.WEIGHTDER'
660 include 'COMMON.IOUNITS'
661 include 'COMMON.CALC'
663 c double precision rrsave(maxdim)
669 eneps_temp(j,i)=0.0d0
673 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
675 c if (icall.eq.0) then
687 dxi=dc_norm(1,nres+i)
688 dyi=dc_norm(2,nres+i)
689 dzi=dc_norm(3,nres+i)
690 dsci_inv=vbld_inv(i+nres)
692 C Calculate SC interaction energy.
695 do j=istart(i,iint),iend(i,iint)
698 dscj_inv=vbld_inv(j+nres)
699 chi1=chi(itypi,itypj)
700 chi2=chi(itypj,itypi)
707 alf12=0.5D0*(alf1+alf2)
708 C For diagnostics only!!!
721 dxj=dc_norm(1,nres+j)
722 dyj=dc_norm(2,nres+j)
723 dzj=dc_norm(3,nres+j)
724 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
725 cd if (icall.eq.0) then
731 C Calculate the angle-dependent terms of energy & contributions to derivatives.
733 C Calculate whole angle-dependent part of epsilon and contributions
735 fac=(rrij*sigsq)**expon2
736 e1=fac*fac*aa(itypi,itypj)
737 e2=fac*bb(itypi,itypj)
738 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
739 eps2der=evdwij*eps3rt
740 eps3der=evdwij*eps2rt
741 evdwij=evdwij*eps2rt*eps3rt
742 ij=icant(itypi,itypj)
743 aux=eps1*eps2rt**2*eps3rt**2
744 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
745 & /dabs(eps(itypi,itypj))
746 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
750 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
751 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
752 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
753 cd & restyp(itypi),i,restyp(itypj),j,
754 cd & epsi,sigm,chi1,chi2,chip1,chip2,
755 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
756 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
759 C Calculate gradient components.
760 e1=e1*eps1*eps2rt**2*eps3rt**2
761 fac=-expon*(e1+evdwij)
764 C Calculate radial part of the gradient
768 C Calculate the angular part of the gradient and sum add the contributions
769 C to the appropriate components of the Cartesian gradient.
778 C-----------------------------------------------------------------------------
781 C This subroutine calculates the interaction energy of nonbonded side chains
782 C assuming the Gay-Berne potential of interaction.
784 implicit real*8 (a-h,o-z)
786 include 'DIMENSIONS.ZSCOPT'
789 include 'COMMON.LOCAL'
790 include 'COMMON.CHAIN'
791 include 'COMMON.DERIV'
792 include 'COMMON.NAMES'
793 include 'COMMON.INTERACT'
794 include 'COMMON.WEIGHTDER'
795 include 'COMMON.IOUNITS'
796 include 'COMMON.CALC'
803 eneps_temp(j,i)=0.0d0
807 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
810 c if (icall.gt.0) lprn=.true.
818 dxi=dc_norm(1,nres+i)
819 dyi=dc_norm(2,nres+i)
820 dzi=dc_norm(3,nres+i)
821 dsci_inv=vbld_inv(i+nres)
823 C Calculate SC interaction energy.
826 do j=istart(i,iint),iend(i,iint)
829 dscj_inv=vbld_inv(j+nres)
830 sig0ij=sigma(itypi,itypj)
831 chi1=chi(itypi,itypj)
832 chi2=chi(itypj,itypi)
839 alf12=0.5D0*(alf1+alf2)
840 C For diagnostics only!!!
853 dxj=dc_norm(1,nres+j)
854 dyj=dc_norm(2,nres+j)
855 dzj=dc_norm(3,nres+j)
856 c write (iout,*) i,j,xj,yj,zj
857 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
859 C Calculate angle-dependent terms of energy and contributions to their
863 sig=sig0ij*dsqrt(sigsq)
864 rij_shift=1.0D0/rij-sig+sig0ij
865 C I hate to put IF's in the loops, but here don't have another choice!!!!
866 if (rij_shift.le.0.0D0) then
871 c---------------------------------------------------------------
872 rij_shift=1.0D0/rij_shift
874 e1=fac*fac*aa(itypi,itypj)
875 e2=fac*bb(itypi,itypj)
876 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
877 eps2der=evdwij*eps3rt
878 eps3der=evdwij*eps2rt
879 evdwij=evdwij*eps2rt*eps3rt
881 ij=icant(itypi,itypj)
882 aux=eps1*eps2rt**2*eps3rt**2
883 c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
884 c & /dabs(eps(itypi,itypj))
885 c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
886 c-----------------------
887 eps0ij=eps(itypi,itypj)
888 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1/ftune_eps(eps0ij)
889 rr0ij=r0(itypi,itypj)
890 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps0ij
891 c eneps_temp(2,ij)=eneps_temp(2,ij)+(rij_shift*rr0ij)**expon
892 c-----------------------
893 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
894 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
895 c & aux*e2/eps(itypi,itypj)
897 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
898 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
899 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
900 & restyp(itypi),i,restyp(itypj),j,
901 & epsi,sigm,chi1,chi2,chip1,chip2,
902 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
903 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
907 C Calculate gradient components.
908 e1=e1*eps1*eps2rt**2*eps3rt**2
909 fac=-expon*(e1+evdwij)*rij_shift
912 C Calculate the radial part of the gradient
916 C Calculate angular part of the gradient.
924 C-----------------------------------------------------------------------------
925 subroutine egbv(evdw)
927 C This subroutine calculates the interaction energy of nonbonded side chains
928 C assuming the Gay-Berne-Vorobjev potential of interaction.
930 implicit real*8 (a-h,o-z)
932 include 'DIMENSIONS.ZSCOPT'
935 include 'COMMON.LOCAL'
936 include 'COMMON.CHAIN'
937 include 'COMMON.DERIV'
938 include 'COMMON.NAMES'
939 include 'COMMON.INTERACT'
940 include 'COMMON.WEIGHTDER'
941 include 'COMMON.IOUNITS'
942 include 'COMMON.CALC'
949 eneps_temp(j,i)=0.0d0
953 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
956 c if (icall.gt.0) lprn=.true.
964 dxi=dc_norm(1,nres+i)
965 dyi=dc_norm(2,nres+i)
966 dzi=dc_norm(3,nres+i)
967 dsci_inv=vbld_inv(i+nres)
969 C Calculate SC interaction energy.
972 do j=istart(i,iint),iend(i,iint)
975 dscj_inv=vbld_inv(j+nres)
976 sig0ij=sigma(itypi,itypj)
978 chi1=chi(itypi,itypj)
979 chi2=chi(itypj,itypi)
986 alf12=0.5D0*(alf1+alf2)
987 C For diagnostics only!!!
1000 dxj=dc_norm(1,nres+j)
1001 dyj=dc_norm(2,nres+j)
1002 dzj=dc_norm(3,nres+j)
1003 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1005 C Calculate angle-dependent terms of energy and contributions to their
1009 sig=sig0ij*dsqrt(sigsq)
1010 rij_shift=1.0D0/rij-sig+r0ij
1011 C I hate to put IF's in the loops, but here don't have another choice!!!!
1012 if (rij_shift.le.0.0D0) then
1017 c---------------------------------------------------------------
1018 rij_shift=1.0D0/rij_shift
1019 fac=rij_shift**expon
1020 e1=fac*fac*aa(itypi,itypj)
1021 e2=fac*bb(itypi,itypj)
1022 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1023 eps2der=evdwij*eps3rt
1024 eps3der=evdwij*eps2rt
1025 fac_augm=rrij**expon
1026 e_augm=augm(itypi,itypj)*fac_augm
1027 evdwij=evdwij*eps2rt*eps3rt
1028 evdw=evdw+evdwij+e_augm
1029 ij=icant(itypi,itypj)
1030 aux=eps1*eps2rt**2*eps3rt**2
1031 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1032 & /dabs(eps(itypi,itypj))
1033 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1034 c eneps_temp(ij)=eneps_temp(ij)
1035 c & +(evdwij+e_augm)/eps(itypi,itypj)
1037 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1038 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1039 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1040 c & restyp(itypi),i,restyp(itypj),j,
1041 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1042 c & chi1,chi2,chip1,chip2,
1043 c & eps1,eps2rt**2,eps3rt**2,
1044 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1048 C Calculate gradient components.
1049 e1=e1*eps1*eps2rt**2*eps3rt**2
1050 fac=-expon*(e1+evdwij)*rij_shift
1052 fac=rij*fac-2*expon*rrij*e_augm
1053 C Calculate the radial part of the gradient
1057 C Calculate angular part of the gradient.
1065 C-----------------------------------------------------------------------------
1066 SUBROUTINE emomo(evdw,evdw_p,evdw_m)
1068 C This subroutine calculates the interaction energy of nonbonded side chains
1069 C assuming the Gay-Berne potential of interaction.
1072 INCLUDE 'DIMENSIONS'
1073 INCLUDE 'DIMENSIONS.ZSCOPT'
1074 INCLUDE 'COMMON.CALC'
1075 INCLUDE 'COMMON.CONTROL'
1076 INCLUDE 'COMMON.CHAIN'
1077 INCLUDE 'COMMON.DERIV'
1078 INCLUDE 'COMMON.EMP'
1079 INCLUDE 'COMMON.GEO'
1080 INCLUDE 'COMMON.INTERACT'
1081 INCLUDE 'COMMON.IOUNITS'
1082 INCLUDE 'COMMON.LOCAL'
1083 INCLUDE 'COMMON.NAMES'
1084 INCLUDE 'COMMON.VAR'
1085 INCLUDE 'COMMON.WEIGHTDER'
1086 logical lprn,energy_dec
1087 double precision scalar
1088 double precision ener(4)
1094 IF (energy_dec) write (iout,'(a)')
1095 & ' AAi i AAj j 1/rij Rtail Rhead evdwij Fcav Ecl
1096 & Egb Epol Fisocav Elj Equad evdw'
1101 ccccc energy_dec=.false.
1102 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1104 c if (icall.eq.0) lprn=.false.
1107 DO i = iatsc_s, iatsc_e
1109 c itypi1 = itype(i+1)
1110 dxi = dc_norm(1,nres+i)
1111 dyi = dc_norm(2,nres+i)
1112 dzi = dc_norm(3,nres+i)
1113 c dsci_inv=dsc_inv(itypi)
1114 dsci_inv = vbld_inv(i+nres)
1116 c ctail(k,1) = c(k, i+nres)
1117 c & - dtail(1,itypi,itypj) * dc_norm(k, nres+i)
1122 c!-------------------------------------------------------------------
1123 C Calculate SC interaction energy.
1124 DO iint = 1, nint_gr(i)
1125 DO j = istart(i,iint), iend(i,iint)
1126 c! initialize variables for electrostatic gradients
1127 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
1129 c dscj_inv = dsc_inv(itypj)
1130 dscj_inv = vbld_inv(j+nres)
1131 c! rij holds 1/(distance of Calpha atoms)
1132 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
1134 c!-------------------------------------------------------------------
1135 C Calculate angle-dependent terms of energy and contributions to their
1139 c! DO troll = 10, 5000
1143 c! sqom1 = om1 * om1
1144 c! sqom2 = om2 * om2
1145 c! sqom12 = om12 * om12
1146 c! rij = 5.0d0 / troll
1148 c! Rtail = troll / 5.0d0
1149 c! Rhead = troll / 5.0d0
1150 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1151 c! Rtail = dsqrt((Rtail**2)
1152 c! & +((dabs(dtail(1,itypi,itypj)-dtail(2,itypi,itypj)))**2))
1153 c! rij = 1.0d0/Rtail
1157 c! this should be in elgrad_init but om's are calculated by sc_angular
1158 c! which in turn is used by older potentials
1159 c! which proves how tangled UNRES code is >.<
1160 c! om = omega, sqom = om^2
1163 sqom12 = om12 * om12
1165 c! now we calculate EGB - Gey-Berne
1166 c! It will be summed up in evdwij and saved in evdw
1167 sigsq = 1.0D0 / sigsq
1168 sig = sig0ij * dsqrt(sigsq)
1169 c! rij_shift = 1.0D0 / rij - sig + sig0ij
1170 rij_shift = Rtail - sig + sig0ij
1171 IF (rij_shift.le.0.0D0) THEN
1175 sigder = -sig * sigsq
1176 rij_shift = 1.0D0 / rij_shift
1177 fac = rij_shift**expon
1178 c1 = fac * fac * aa(itypi,itypj)
1180 c2 = fac * bb(itypi,itypj)
1182 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
1183 eps2der = eps3rt * evdwij
1184 eps3der = eps2rt * evdwij
1185 c! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
1186 evdwij = eps2rt * eps3rt * evdwij
1188 c! write (*,*) "Gey Berne = ", evdwij
1190 IF (bb(itypi,itypj).gt.0) THEN
1191 evdw_p = evdw_p + evdwij
1193 evdw_m = evdw_m + evdwij
1199 c!-------------------------------------------------------------------
1200 c! Calculate some components of GGB
1201 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
1202 fac = -expon * (c1 + evdwij) * rij_shift
1203 sigder = fac * sigder
1205 c! Calculate distance derivative
1212 c! write (*,*) "gg(1) = ", gg(1)
1213 c! write (*,*) "gg(2) = ", gg(2)
1214 c! write (*,*) "gg(3) = ", gg(3)
1215 c! The angular derivatives of GGB are brought together in sc_grad
1216 c!-------------------------------------------------------------------
1219 c! Catch gly-gly interactions to skip calculation of something that
1222 IF (itypi.eq.10.and.itypj.eq.10) THEN
1230 c! we are not 2 glycines, so we calculate Fcav (and maybe more)
1231 fac = chis1 * sqom1 + chis2 * sqom2
1232 & - 2.0d0 * chis12 * om1 * om2 * om12
1233 c! we will use pom later in Gcav, so dont mess with it!
1234 pom = 1.0d0 - chis1 * chis2 * sqom12
1236 Lambf = (1.0d0 - (fac / pom))
1237 Lambf = dsqrt(Lambf)
1240 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
1241 c! write (*,*) "sparrow = ", sparrow
1242 Chif = Rtail * sparrow
1243 ChiLambf = Chif * Lambf
1244 eagle = dsqrt(ChiLambf)
1245 bat = ChiLambf ** 11.0d0
1247 top = b1 * ( eagle + b2 * ChiLambf - b3 )
1248 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
1251 c! write (*,*) "sig1 = ",sig1
1252 c! write (*,*) "sig2 = ",sig2
1253 c! write (*,*) "Rtail = ",Rtail
1254 c! write (*,*) "sparrow = ",sparrow
1255 c! write (*,*) "Chis1 = ", chis1
1256 c! write (*,*) "Chis2 = ", chis2
1257 c! write (*,*) "Chis12 = ", chis12
1258 c! write (*,*) "om1 = ", om1
1259 c! write (*,*) "om2 = ", om2
1260 c! write (*,*) "om12 = ", om12
1261 c! write (*,*) "sqom1 = ", sqom1
1262 c! write (*,*) "sqom2 = ", sqom2
1263 c! write (*,*) "sqom12 = ", sqom12
1264 c! write (*,*) "Lambf = ",Lambf
1265 c! write (*,*) "b1 = ",b1
1266 c! write (*,*) "b2 = ",b2
1267 c! write (*,*) "b3 = ",b3
1268 c! write (*,*) "b4 = ",b4
1269 c! write (*,*) "top = ",top
1270 c! write (*,*) "bot = ",bot
1273 c! write (*,*) "Fcav = ", Fcav
1274 c!-------------------------------------------------------------------
1275 c! derivative of Fcav is Gcav...
1276 c!---------------------------------------------------
1278 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
1279 dbot = 12.0d0 * b4 * bat * Lambf
1280 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
1282 c! write (*,*) "dFcav/dR = ", dFdR
1284 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
1285 dbot = 12.0d0 * b4 * bat * Chif
1287 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
1288 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
1289 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2)
1290 & * (chis2 * om2 * om12 - om1) / (eagle * pom)
1292 dFdL = ((dtop * bot - top * dbot) / botsq)
1294 dCAVdOM1 = dFdL * ( dFdOM1 )
1295 dCAVdOM2 = dFdL * ( dFdOM2 )
1296 dCAVdOM12 = dFdL * ( dFdOM12 )
1297 c! write (*,*) "dFcav/dOM1 = ", dCAVdOM1
1298 c! write (*,*) "dFcav/dOM2 = ", dCAVdOM2
1299 c! write (*,*) "dFcav/dOM12 = ", dCAVdOM12
1301 c!-------------------------------------------------------------------
1302 c! Finally, add the distance derivatives of GB and Fcav to gvdwc
1303 c! Pom is used here to project the gradient vector into
1304 c! cartesian coordinates and at the same time contains
1305 c! dXhb/dXsc derivative (for charged amino acids
1306 c! location of hydrophobic centre of interaction is not
1307 c! the same as geometric centre of side chain, this
1308 c! derivative takes that into account)
1309 c! derivatives of omega angles will be added in sc_grad
1312 ertail(k) = Rtail_distance(k)/Rtail
1314 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
1315 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
1316 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1317 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1319 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1320 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1321 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
1322 gvdwx(k,i) = gvdwx(k,i)
1323 & - (( dFdR + gg(k) ) * pom)
1324 c! & - ( dFdR * pom )
1325 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
1326 gvdwx(k,j) = gvdwx(k,j)
1327 & + (( dFdR + gg(k) ) * pom)
1328 c! & + ( dFdR * pom )
1330 gvdwc(k,i) = gvdwc(k,i)
1331 & - (( dFdR + gg(k) ) * ertail(k))
1332 c! & - ( dFdR * ertail(k))
1334 gvdwc(k,j) = gvdwc(k,j)
1335 & + (( dFdR + gg(k) ) * ertail(k))
1336 c! & + ( dFdR * ertail(k))
1339 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
1340 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
1343 c!-------------------------------------------------------------------
1344 c! Compute head-head and head-tail energies for each state
1346 isel = iabs(Qi) + iabs(Qj)
1348 c! No charges - do nothing
1351 ELSE IF (isel.eq.4) THEN
1352 c! Calculate dipole-dipole interactions
1356 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
1357 c! Charge-nonpolar interactions
1361 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
1362 c! Nonpolar-charge interactions
1366 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
1367 c! Charge-dipole interactions
1368 CALL eqd(ecl, elj, epol)
1369 eheadtail = ECL + elj + epol
1371 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
1372 c! Dipole-charge interactions
1373 CALL edq(ecl, elj, epol)
1374 eheadtail = ECL + elj + epol
1376 ELSE IF ((isel.eq.2.and.
1377 & iabs(Qi).eq.1).and.
1378 & nstate(itypi,itypj).eq.1) THEN
1379 c! Same charge-charge interaction ( +/+ or -/- )
1380 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
1381 eheadtail = ECL + Egb + Epol + Fisocav + Elj
1383 ELSE IF ((isel.eq.2.and.
1384 & iabs(Qi).eq.1).and.
1385 & nstate(itypi,itypj).ne.1) THEN
1386 c! Different charge-charge interaction ( +/- or -/+ )
1388 & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1390 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
1391 c! write (*,*) "evdw = ", evdw
1392 c! write (*,*) "Fcav = ", Fcav
1393 c! write (*,*) "eheadtail = ", eheadtail
1397 ij=icant(itypi,itypj)
1398 eneps_temp(1,ij)=eneps_temp(1,ij)+evdwij
1399 eneps_temp(2,ij)=eneps_temp(2,ij)+Fcav
1400 eneps_temp(3,ij)=eheadtail
1401 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,9f16.7)')
1402 & restyp(itype(i)),i,restyp(itype(j)),j,
1403 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1405 IF (energy_dec) write (*,'(2(1x,a3,i3),3f6.2,9f16.7)')
1406 & restyp(itype(i)),i,restyp(itype(j)),j,
1407 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
1414 c!-------------------------------------------------------------------
1415 c! As all angular derivatives are done, now we sum them up,
1416 c! then transform and project into cartesian vectors and add to gvdwc
1417 c! We call sc_grad always, with the exception of +/- interaction.
1418 c! This is because energy_quad subroutine needs to handle
1419 c! this job in his own way.
1420 c! This IS probably not very efficient and SHOULD be optimised
1421 c! but it will require major restructurization of emomo
1422 c! so it will be left as it is for now
1423 c! write (*,*) 'troll1, nstate =', nstate (itypi,itypj)
1424 IF (nstate(itypi,itypj).eq.1) THEN
1426 IF (bb(itypi,itypj).gt.0) THEN
1435 c!-------------------------------------------------------------------
1440 c write (iout,*) "Number of loop steps in EGB:",ind
1441 c energy_dec=.false.
1443 END SUBROUTINE emomo
1445 C-----------------------------------------------------------------------------
1446 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
1448 INCLUDE 'DIMENSIONS'
1449 INCLUDE 'DIMENSIONS.ZSCOPT'
1450 INCLUDE 'COMMON.CALC'
1451 INCLUDE 'COMMON.CHAIN'
1452 INCLUDE 'COMMON.CONTROL'
1453 INCLUDE 'COMMON.DERIV'
1454 INCLUDE 'COMMON.EMP'
1455 INCLUDE 'COMMON.GEO'
1456 INCLUDE 'COMMON.INTERACT'
1457 INCLUDE 'COMMON.IOUNITS'
1458 INCLUDE 'COMMON.LOCAL'
1459 INCLUDE 'COMMON.NAMES'
1460 INCLUDE 'COMMON.VAR'
1461 double precision scalar, facd3, facd4, federmaus, adler
1462 c! Epol and Gpol analytical parameters
1463 alphapol1 = alphapol(itypi,itypj)
1464 alphapol2 = alphapol(itypj,itypi)
1465 c! Fisocav and Gisocav analytical parameters
1466 al1 = alphiso(1,itypi,itypj)
1467 al2 = alphiso(2,itypi,itypj)
1468 al3 = alphiso(3,itypi,itypj)
1469 al4 = alphiso(4,itypi,itypj)
1471 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1472 & + sigiso2(itypi,itypj)**2.0d0))
1474 pis = sig0head(itypi,itypj)
1475 eps_head = epshead(itypi,itypj)
1476 Rhead_sq = Rhead * Rhead
1477 c! R1 - distance between head of ith side chain and tail of jth sidechain
1478 c! R2 - distance between head of jth side chain and tail of ith sidechain
1482 c! Calculate head-to-tail distances needed by Epol
1483 R1=R1+(ctail(k,2)-chead(k,1))**2
1484 R2=R2+(chead(k,2)-ctail(k,1))**2
1490 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1491 c! & +dhead(1,1,itypi,itypj))**2))
1492 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1493 c! & +dhead(2,1,itypi,itypj))**2))
1494 c!-------------------------------------------------------------------
1495 c! Coulomb electrostatic interaction
1496 Ecl = (332.0d0 * Qij) / Rhead
1497 c! derivative of Ecl is Gcl...
1498 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
1502 c!-------------------------------------------------------------------
1503 c! Generalised Born Solvent Polarization
1504 c! Charged head polarizes the solvent
1505 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1506 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1507 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1508 c! Derivative of Egb is Ggb...
1509 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1510 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1512 dGGBdR = dGGBdFGB * dFGBdR
1513 c!-------------------------------------------------------------------
1514 c! Fisocav - isotropic cavity creation term
1515 c! or "how much energy it costs to put charged head in water"
1517 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1518 bot = (1.0d0 + al4 * pom**12.0d0)
1521 c! write (*,*) "Rhead = ",Rhead
1522 c! write (*,*) "csig = ",csig
1523 c! write (*,*) "pom = ",pom
1524 c! write (*,*) "al1 = ",al1
1525 c! write (*,*) "al2 = ",al2
1526 c! write (*,*) "al3 = ",al3
1527 c! write (*,*) "al4 = ",al4
1528 c! write (*,*) "top = ",top
1529 c! write (*,*) "bot = ",bot
1530 c! Derivative of Fisocav is GCV...
1531 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1532 dbot = 12.0d0 * al4 * pom ** 11.0d0
1533 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1534 c!-------------------------------------------------------------------
1536 c! Polarization energy - charged heads polarize hydrophobic "neck"
1537 MomoFac1 = (1.0d0 - chi1 * sqom2)
1538 MomoFac2 = (1.0d0 - chi2 * sqom1)
1539 RR1 = ( R1 * R1 ) / MomoFac1
1540 RR2 = ( R2 * R2 ) / MomoFac2
1541 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1542 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1543 fgb1 = sqrt( RR1 + a12sq * ee1 )
1544 fgb2 = sqrt( RR2 + a12sq * ee2 )
1545 epol = 332.0d0 * eps_inout_fac * (
1546 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1548 c write (*,*) "eps_inout_fac = ",eps_inout_fac
1549 c write (*,*) "alphapol1 = ", alphapol1
1550 c write (*,*) "alphapol2 = ", alphapol2
1551 c write (*,*) "fgb1 = ", fgb1
1552 c write (*,*) "fgb2 = ", fgb2
1553 c write (*,*) "epol = ", epol
1554 c! derivative of Epol is Gpol...
1555 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1557 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1559 dFGBdR1 = ( (R1 / MomoFac1)
1560 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1561 & / ( 2.0d0 * fgb1 )
1562 dFGBdR2 = ( (R2 / MomoFac2)
1563 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1564 & / ( 2.0d0 * fgb2 )
1565 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1566 & * ( 2.0d0 - 0.5d0 * ee1) )
1567 & / ( 2.0d0 * fgb1 )
1568 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1569 & * ( 2.0d0 - 0.5d0 * ee2) )
1570 & / ( 2.0d0 * fgb2 )
1571 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1573 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1575 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1577 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1579 c!-------------------------------------------------------------------
1581 c! Lennard-Jones 6-12 interaction between heads
1582 pom = (pis / Rhead)**6.0d0
1583 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1584 c! derivative of Elj is Glj
1585 dGLJdR = 4.0d0 * eps_head
1586 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1587 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1588 c!-------------------------------------------------------------------
1589 c! Return the results
1590 c! These things do the dRdX derivatives, that is
1591 c! allow us to change what we see from function that changes with
1592 c! distance to function that changes with LOCATION (of the interaction
1595 erhead(k) = Rhead_distance(k)/Rhead
1596 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1597 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1600 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1601 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1602 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1603 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1604 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1605 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1606 facd1 = d1 * vbld_inv(i+nres)
1607 facd2 = d2 * vbld_inv(j+nres)
1608 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1609 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1611 c! Now we add appropriate partial derivatives (one in each dimension)
1613 hawk = (erhead_tail(k,1) +
1614 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
1615 condor = (erhead_tail(k,2) +
1616 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
1618 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1619 gvdwx(k,i) = gvdwx(k,i)
1624 & - dPOLdR2 * (erhead_tail(k,2)
1625 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1628 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1629 gvdwx(k,j) = gvdwx(k,j)
1633 & + dPOLdR1 * (erhead_tail(k,1)
1634 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1635 & + dPOLdR2 * condor
1638 gvdwc(k,i) = gvdwc(k,i)
1639 & - dGCLdR * erhead(k)
1640 & - dGGBdR * erhead(k)
1641 & - dGCVdR * erhead(k)
1642 & - dPOLdR1 * erhead_tail(k,1)
1643 & - dPOLdR2 * erhead_tail(k,2)
1644 & - dGLJdR * erhead(k)
1646 gvdwc(k,j) = gvdwc(k,j)
1647 & + dGCLdR * erhead(k)
1648 & + dGGBdR * erhead(k)
1649 & + dGCVdR * erhead(k)
1650 & + dPOLdR1 * erhead_tail(k,1)
1651 & + dPOLdR2 * erhead_tail(k,2)
1652 & + dGLJdR * erhead(k)
1657 c!-------------------------------------------------------------------
1658 SUBROUTINE energy_quad
1659 &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
1661 INCLUDE 'DIMENSIONS'
1662 INCLUDE 'DIMENSIONS.ZSCOPT'
1663 INCLUDE 'COMMON.CALC'
1664 INCLUDE 'COMMON.CHAIN'
1665 INCLUDE 'COMMON.CONTROL'
1666 INCLUDE 'COMMON.DERIV'
1667 INCLUDE 'COMMON.EMP'
1668 INCLUDE 'COMMON.GEO'
1669 INCLUDE 'COMMON.INTERACT'
1670 INCLUDE 'COMMON.IOUNITS'
1671 INCLUDE 'COMMON.LOCAL'
1672 INCLUDE 'COMMON.NAMES'
1673 INCLUDE 'COMMON.VAR'
1674 double precision scalar
1675 double precision ener(4)
1676 double precision dcosom1(3),dcosom2(3)
1677 c! used in Epol derivatives
1678 double precision facd3, facd4
1679 double precision federmaus, adler
1680 c! Epol and Gpol analytical parameters
1681 alphapol1 = alphapol(itypi,itypj)
1682 alphapol2 = alphapol(itypj,itypi)
1683 c! Fisocav and Gisocav analytical parameters
1684 al1 = alphiso(1,itypi,itypj)
1685 al2 = alphiso(2,itypi,itypj)
1686 al3 = alphiso(3,itypi,itypj)
1687 al4 = alphiso(4,itypi,itypj)
1689 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
1690 & + sigiso2(itypi,itypj)**2.0d0))
1692 w1 = wqdip(1,itypi,itypj)
1693 w2 = wqdip(2,itypi,itypj)
1694 pis = sig0head(itypi,itypj)
1695 eps_head = epshead(itypi,itypj)
1696 c! First things first:
1697 c! We need to do sc_grad's job with GB and Fcav
1699 & eps2der * eps2rt_om1
1700 & - 2.0D0 * alf1 * eps3der
1701 & + sigder * sigsq_om1
1704 & eps2der * eps2rt_om2
1705 & + 2.0D0 * alf2 * eps3der
1706 & + sigder * sigsq_om2
1709 & evdwij * eps1_om12
1710 & + eps2der * eps2rt_om12
1711 & - 2.0D0 * alf12 * eps3der
1712 & + sigder *sigsq_om12
1714 c! now some magical transformations to project gradient into
1715 c! three cartesian vectors
1717 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1718 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1719 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
1720 c! this acts on hydrophobic center of interaction
1721 gvdwx(k,i)= gvdwx(k,i) - gg(k)
1722 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1723 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1724 gvdwx(k,j)= gvdwx(k,j) + gg(k)
1725 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1726 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1727 c! this acts on Calpha
1728 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1729 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1731 c! sc_grad is done, now we will compute
1740 c! d1 = dhead(1, 1, itypi, itypj)
1741 c! d2 = dhead(2, 1, itypi, itypj)
1742 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1743 c! & +dhead(1,ii,itypi,itypj))**2))
1744 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1745 c! & +dhead(2,jj,itypi,itypj))**2))
1746 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1747 c! END OF ENERGY DEBUG
1748 c*************************************************************
1749 DO istate = 1, nstate(itypi,itypj)
1750 c*************************************************************
1751 IF (istate.ne.1) THEN
1752 IF (istate.lt.3) THEN
1758 d1 = dhead(1,ii,itypi,itypj)
1759 d2 = dhead(2,jj,itypi,itypj)
1761 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
1762 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
1763 Rhead_distance(k) = chead(k,2) - chead(k,1)
1765 c! pitagoras (root of sum of squares)
1767 & (Rhead_distance(1)*Rhead_distance(1))
1768 & + (Rhead_distance(2)*Rhead_distance(2))
1769 & + (Rhead_distance(3)*Rhead_distance(3)))
1771 Rhead_sq = Rhead * Rhead
1773 c! R1 - distance between head of ith side chain and tail of jth sidechain
1774 c! R2 - distance between head of jth side chain and tail of ith sidechain
1778 c! Calculate head-to-tail distances
1779 R1=R1+(ctail(k,2)-chead(k,1))**2
1780 R2=R2+(chead(k,2)-ctail(k,1))**2
1787 c! write (*,*) "istate = ", istate
1788 c! write (*,*) "ii = ", ii
1789 c! write (*,*) "jj = ", jj
1790 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
1791 c! & +dhead(1,ii,itypi,itypj))**2))
1792 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
1793 c! & +dhead(2,jj,itypi,itypj))**2))
1794 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1795 c! Rhead_sq = Rhead * Rhead
1796 c! write (*,*) "d1 = ",d1
1797 c! write (*,*) "d2 = ",d2
1798 c! write (*,*) "R1 = ",R1
1799 c! write (*,*) "R2 = ",R2
1800 c! write (*,*) "Rhead = ",Rhead
1801 c! END OF ENERGY DEBUG
1803 c!-------------------------------------------------------------------
1804 c! Coulomb electrostatic interaction
1805 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
1807 c! write (*,*) "Ecl = ", Ecl
1808 c! derivative of Ecl is Gcl...
1809 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
1814 c!-------------------------------------------------------------------
1815 c! Generalised Born Solvent Polarization
1816 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
1817 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
1818 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
1820 c! write (*,*) "a1*a2 = ", a12sq
1821 c! write (*,*) "Rhead = ", Rhead
1822 c! write (*,*) "Rhead_sq = ", Rhead_sq
1823 c! write (*,*) "ee = ", ee
1824 c! write (*,*) "Fgb = ", Fgb
1825 c! write (*,*) "fac = ", eps_inout_fac
1826 c! write (*,*) "Qij = ", Qij
1827 c! write (*,*) "Egb = ", Egb
1828 c! Derivative of Egb is Ggb...
1829 c! dFGBdR is used by Quad's later...
1830 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
1831 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
1833 dGGBdR = dGGBdFGB * dFGBdR
1835 c!-------------------------------------------------------------------
1836 c! Fisocav - isotropic cavity creation term
1838 top = al1 * (dsqrt(pom) + al2 * pom - al3)
1839 bot = (1.0d0 + al4 * pom**12.0d0)
1843 c! write (*,*) "pom = ",pom
1844 c! write (*,*) "al1 = ",al1
1845 c! write (*,*) "al2 = ",al2
1846 c! write (*,*) "al3 = ",al3
1847 c! write (*,*) "al4 = ",al4
1848 c! write (*,*) "top = ",top
1849 c! write (*,*) "bot = ",bot
1850 c! write (*,*) "Fisocav = ", Fisocav
1852 c! Derivative of Fisocav is GCV...
1853 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
1854 dbot = 12.0d0 * al4 * pom ** 11.0d0
1855 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
1857 c!-------------------------------------------------------------------
1858 c! Polarization energy
1860 MomoFac1 = (1.0d0 - chi1 * sqom2)
1861 MomoFac2 = (1.0d0 - chi2 * sqom1)
1862 RR1 = ( R1 * R1 ) / MomoFac1
1863 RR2 = ( R2 * R2 ) / MomoFac2
1864 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
1865 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
1866 fgb1 = sqrt( RR1 + a12sq * ee1 )
1867 fgb2 = sqrt( RR2 + a12sq * ee2 )
1868 epol = 332.0d0 * eps_inout_fac * (
1869 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
1871 c! derivative of Epol is Gpol...
1872 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
1874 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
1876 dFGBdR1 = ( (R1 / MomoFac1)
1877 & * ( 2.0d0 - (0.5d0 * ee1) ) )
1878 & / ( 2.0d0 * fgb1 )
1879 dFGBdR2 = ( (R2 / MomoFac2)
1880 & * ( 2.0d0 - (0.5d0 * ee2) ) )
1881 & / ( 2.0d0 * fgb2 )
1882 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
1883 & * ( 2.0d0 - 0.5d0 * ee1) )
1884 & / ( 2.0d0 * fgb1 )
1885 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
1886 & * ( 2.0d0 - 0.5d0 * ee2) )
1887 & / ( 2.0d0 * fgb2 )
1888 dPOLdR1 = dPOLdFGB1 * dFGBdR1
1890 dPOLdR2 = dPOLdFGB2 * dFGBdR2
1892 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
1894 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
1896 c!-------------------------------------------------------------------
1898 pom = (pis / Rhead)**6.0d0
1899 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
1901 c! derivative of Elj is Glj
1902 dGLJdR = 4.0d0 * eps_head
1903 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
1904 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
1906 c!-------------------------------------------------------------------
1908 IF (Wqd.ne.0.0d0) THEN
1909 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0)
1910 & - 37.5d0 * ( sqom1 + sqom2 )
1911 & + 157.5d0 * ( sqom1 * sqom2 )
1912 & - 45.0d0 * om1*om2*om12
1913 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
1916 c! derivative of Equad...
1917 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
1920 & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
1921 c! dQUADdOM1 = 0.0d0
1923 & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
1924 c! dQUADdOM2 = 0.0d0
1926 & * ( 6.0d0*om12 - 45.0d0*om1*om2 )
1927 c! dQUADdOM12 = 0.0d0
1932 c!-------------------------------------------------------------------
1933 c! Return the results
1935 eom1 = dPOLdOM1 + dQUADdOM1
1936 eom2 = dPOLdOM2 + dQUADdOM2
1938 c! now some magical transformations to project gradient into
1939 c! three cartesian vectors
1941 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
1942 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
1943 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
1947 erhead(k) = Rhead_distance(k)/Rhead
1948 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
1949 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
1951 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
1952 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
1953 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
1954 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
1955 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
1956 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
1957 facd1 = d1 * vbld_inv(i+nres)
1958 facd2 = d2 * vbld_inv(j+nres)
1959 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
1960 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
1961 c! Throw the results into gheadtail which holds gradients
1962 c! for each micro-state
1964 hawk = erhead_tail(k,1) +
1965 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
1966 condor = erhead_tail(k,2) +
1967 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
1969 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
1970 c! this acts on hydrophobic center of interaction
1971 gheadtail(k,1,1) = gheadtail(k,1,1)
1976 & - dPOLdR2 * (erhead_tail(k,2)
1977 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
1981 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1982 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1984 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
1985 c! this acts on hydrophobic center of interaction
1986 gheadtail(k,2,1) = gheadtail(k,2,1)
1990 & + dPOLdR1 * (erhead_tail(k,1)
1991 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
1992 & + dPOLdR2 * condor
1996 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1997 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1999 c! this acts on Calpha
2000 gheadtail(k,3,1) = gheadtail(k,3,1)
2001 & - dGCLdR * erhead(k)
2002 & - dGGBdR * erhead(k)
2003 & - dGCVdR * erhead(k)
2004 & - dPOLdR1 * erhead_tail(k,1)
2005 & - dPOLdR2 * erhead_tail(k,2)
2006 & - dGLJdR * erhead(k)
2007 & - dQUADdR * erhead(k)
2010 c! this acts on Calpha
2011 gheadtail(k,4,1) = gheadtail(k,4,1)
2012 & + dGCLdR * erhead(k)
2013 & + dGGBdR * erhead(k)
2014 & + dGCVdR * erhead(k)
2015 & + dPOLdR1 * erhead_tail(k,1)
2016 & + dPOLdR2 * erhead_tail(k,2)
2017 & + dGLJdR * erhead(k)
2018 & + dQUADdR * erhead(k)
2021 c! write(*,*) "ECL = ", Ecl
2022 c! write(*,*) "Egb = ", Egb
2023 c! write(*,*) "Epol = ", Epol
2024 c! write(*,*) "Fisocav = ", Fisocav
2025 c! write(*,*) "Elj = ", Elj
2026 c! write(*,*) "Equad = ", Equad
2027 c! write(*,*) "wstate = ", wstate(istate,itypi,itypj)
2028 c! write(*,*) "eheadtail = ", eheadtail
2029 c! write(*,*) "TROLL = ", dexp(-betaT * ener(istate))
2030 c! write(*,*) "dGCLdR = ", dGCLdR
2031 c! write(*,*) "dGGBdR = ", dGGBdR
2032 c! write(*,*) "dGCVdR = ", dGCVdR
2033 c! write(*,*) "dPOLdR1 = ", dPOLdR1
2034 c! write(*,*) "dPOLdR2 = ", dPOLdR2
2035 c! write(*,*) "dGLJdR = ", dGLJdR
2036 c! write(*,*) "dQUADdR = ", dQUADdR
2037 c! write(*,*) "tuna(",k,") = ", tuna(k)
2038 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
2039 eheadtail = eheadtail
2040 & + wstate(istate, itypi, itypj)
2041 & * dexp(-betaT * ener(istate))
2042 c! foreach cartesian dimension
2044 c! foreach of two gvdwx and gvdwc
2046 gheadtail(k,l,2) = gheadtail(k,l,2)
2047 & + wstate( istate, itypi, itypj )
2048 & * dexp(-betaT * ener(istate))
2049 & * gheadtail(k,l,1)
2050 gheadtail(k,l,1) = 0.0d0
2054 c! Here ended the gigantic DO istate = 1, 4, which starts
2055 c! at the beggining of the subroutine
2059 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
2061 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
2062 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
2063 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
2064 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
2066 gheadtail(k,l,1) = 0.0d0
2067 gheadtail(k,l,2) = 0.0d0
2070 eheadtail = (-dlog(eheadtail)) / betaT
2077 END SUBROUTINE energy_quad
2078 c!-------------------------------------------------------------------
2079 SUBROUTINE eqn(Epol)
2081 INCLUDE 'DIMENSIONS'
2082 INCLUDE 'DIMENSIONS.ZSCOPT'
2083 INCLUDE 'COMMON.CALC'
2084 INCLUDE 'COMMON.CHAIN'
2085 INCLUDE 'COMMON.CONTROL'
2086 INCLUDE 'COMMON.DERIV'
2087 INCLUDE 'COMMON.EMP'
2088 INCLUDE 'COMMON.GEO'
2089 INCLUDE 'COMMON.INTERACT'
2090 INCLUDE 'COMMON.IOUNITS'
2091 INCLUDE 'COMMON.LOCAL'
2092 INCLUDE 'COMMON.NAMES'
2093 INCLUDE 'COMMON.VAR'
2094 double precision scalar, facd4, federmaus
2095 alphapol1 = alphapol(itypi,itypj)
2096 c! R1 - distance between head of ith side chain and tail of jth sidechain
2099 c! Calculate head-to-tail distances
2100 R1=R1+(ctail(k,2)-chead(k,1))**2
2105 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2106 c! & +dhead(1,1,itypi,itypj))**2))
2107 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2108 c! & +dhead(2,1,itypi,itypj))**2))
2109 c--------------------------------------------------------------------
2110 c Polarization energy
2112 MomoFac1 = (1.0d0 - chi1 * sqom2)
2113 RR1 = R1 * R1 / MomoFac1
2114 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2115 fgb1 = sqrt( RR1 + a12sq * ee1)
2116 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2118 c!------------------------------------------------------------------
2119 c! derivative of Epol is Gpol...
2120 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2122 dFGBdR1 = ( (R1 / MomoFac1)
2123 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2124 & / ( 2.0d0 * fgb1 )
2125 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2126 & * (2.0d0 - 0.5d0 * ee1) )
2128 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2131 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2133 c!-------------------------------------------------------------------
2134 c! Return the results
2135 c! (see comments in Eqq)
2137 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2139 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2140 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2141 facd1 = d1 * vbld_inv(i+nres)
2142 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2145 hawk = (erhead_tail(k,1) +
2146 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2148 gvdwx(k,i) = gvdwx(k,i)
2150 gvdwx(k,j) = gvdwx(k,j)
2151 & + dPOLdR1 * (erhead_tail(k,1)
2152 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2154 gvdwc(k,i) = gvdwc(k,i)
2155 & - dPOLdR1 * erhead_tail(k,1)
2156 gvdwc(k,j) = gvdwc(k,j)
2157 & + dPOLdR1 * erhead_tail(k,1)
2164 c!-------------------------------------------------------------------
2168 SUBROUTINE enq(Epol)
2170 INCLUDE 'DIMENSIONS'
2171 INCLUDE 'DIMENSIONS.ZSCOPT'
2172 INCLUDE 'COMMON.CALC'
2173 INCLUDE 'COMMON.CHAIN'
2174 INCLUDE 'COMMON.CONTROL'
2175 INCLUDE 'COMMON.DERIV'
2176 INCLUDE 'COMMON.EMP'
2177 INCLUDE 'COMMON.GEO'
2178 INCLUDE 'COMMON.INTERACT'
2179 INCLUDE 'COMMON.IOUNITS'
2180 INCLUDE 'COMMON.LOCAL'
2181 INCLUDE 'COMMON.NAMES'
2182 INCLUDE 'COMMON.VAR'
2183 double precision scalar, facd3, adler
2184 alphapol2 = alphapol(itypj,itypi)
2185 c! R2 - distance between head of jth side chain and tail of ith sidechain
2188 c! Calculate head-to-tail distances
2189 R2=R2+(chead(k,2)-ctail(k,1))**2
2194 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2195 c! & +dhead(1,1,itypi,itypj))**2))
2196 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2197 c! & +dhead(2,1,itypi,itypj))**2))
2198 c------------------------------------------------------------------------
2199 c Polarization energy
2200 MomoFac2 = (1.0d0 - chi2 * sqom1)
2201 RR2 = R2 * R2 / MomoFac2
2202 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2203 fgb2 = sqrt(RR2 + a12sq * ee2)
2204 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2206 c!-------------------------------------------------------------------
2207 c! derivative of Epol is Gpol...
2208 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2210 dFGBdR2 = ( (R2 / MomoFac2)
2211 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2213 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2214 & * (2.0d0 - 0.5d0 * ee2) )
2216 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2218 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2221 c!-------------------------------------------------------------------
2222 c! Return the results
2223 c! (See comments in Eqq)
2225 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2227 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2228 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2229 facd2 = d2 * vbld_inv(j+nres)
2230 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2232 condor = (erhead_tail(k,2)
2233 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2235 gvdwx(k,i) = gvdwx(k,i)
2236 & - dPOLdR2 * (erhead_tail(k,2)
2237 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2238 gvdwx(k,j) = gvdwx(k,j)
2239 & + dPOLdR2 * condor
2241 gvdwc(k,i) = gvdwc(k,i)
2242 & - dPOLdR2 * erhead_tail(k,2)
2243 gvdwc(k,j) = gvdwc(k,j)
2244 & + dPOLdR2 * erhead_tail(k,2)
2251 c!-------------------------------------------------------------------
2254 SUBROUTINE eqd(Ecl,Elj,Epol)
2256 INCLUDE 'DIMENSIONS'
2257 INCLUDE 'DIMENSIONS.ZSCOPT'
2258 INCLUDE 'COMMON.CALC'
2259 INCLUDE 'COMMON.CHAIN'
2260 INCLUDE 'COMMON.CONTROL'
2261 INCLUDE 'COMMON.DERIV'
2262 INCLUDE 'COMMON.EMP'
2263 INCLUDE 'COMMON.GEO'
2264 INCLUDE 'COMMON.INTERACT'
2265 INCLUDE 'COMMON.IOUNITS'
2266 INCLUDE 'COMMON.LOCAL'
2267 INCLUDE 'COMMON.NAMES'
2268 INCLUDE 'COMMON.VAR'
2269 double precision scalar, facd4, federmaus
2270 alphapol1 = alphapol(itypi,itypj)
2271 w1 = wqdip(1,itypi,itypj)
2272 w2 = wqdip(2,itypi,itypj)
2273 pis = sig0head(itypi,itypj)
2274 eps_head = epshead(itypi,itypj)
2275 c!-------------------------------------------------------------------
2276 c! R1 - distance between head of ith side chain and tail of jth sidechain
2279 c! Calculate head-to-tail distances
2280 R1=R1+(ctail(k,2)-chead(k,1))**2
2285 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2286 c! & +dhead(1,1,itypi,itypj))**2))
2287 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2288 c! & +dhead(2,1,itypi,itypj))**2))
2290 c!-------------------------------------------------------------------
2292 sparrow = w1 * Qi * om1
2293 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2294 Ecl = sparrow / Rhead**2.0d0
2295 & - hawk / Rhead**4.0d0
2296 c!-------------------------------------------------------------------
2297 c! derivative of ecl is Gcl
2299 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2300 & + 4.0d0 * hawk / Rhead**5.0d0
2302 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2304 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2305 c--------------------------------------------------------------------
2306 c Polarization energy
2308 MomoFac1 = (1.0d0 - chi1 * sqom2)
2309 RR1 = R1 * R1 / MomoFac1
2310 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2311 fgb1 = sqrt( RR1 + a12sq * ee1)
2312 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2314 c!------------------------------------------------------------------
2315 c! derivative of Epol is Gpol...
2316 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2318 dFGBdR1 = ( (R1 / MomoFac1)
2319 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2320 & / ( 2.0d0 * fgb1 )
2321 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2322 & * (2.0d0 - 0.5d0 * ee1) )
2324 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2327 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2329 c!-------------------------------------------------------------------
2331 pom = (pis / Rhead)**6.0d0
2332 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2333 c! derivative of Elj is Glj
2334 dGLJdR = 4.0d0 * eps_head
2335 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2336 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2337 c!-------------------------------------------------------------------
2338 c! Return the results
2340 erhead(k) = Rhead_distance(k)/Rhead
2341 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2344 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2345 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2346 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2347 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2348 facd1 = d1 * vbld_inv(i+nres)
2349 facd2 = d2 * vbld_inv(j+nres)
2350 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2353 hawk = (erhead_tail(k,1) +
2354 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2356 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2357 gvdwx(k,i) = gvdwx(k,i)
2362 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2363 gvdwx(k,j) = gvdwx(k,j)
2365 & + dPOLdR1 * (erhead_tail(k,1)
2366 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2370 gvdwc(k,i) = gvdwc(k,i)
2371 & - dGCLdR * erhead(k)
2372 & - dPOLdR1 * erhead_tail(k,1)
2373 & - dGLJdR * erhead(k)
2375 gvdwc(k,j) = gvdwc(k,j)
2376 & + dGCLdR * erhead(k)
2377 & + dPOLdR1 * erhead_tail(k,1)
2378 & + dGLJdR * erhead(k)
2385 c!-------------------------------------------------------------------
2388 SUBROUTINE edq(Ecl,Elj,Epol)
2390 INCLUDE 'DIMENSIONS'
2391 INCLUDE 'DIMENSIONS.ZSCOPT'
2392 INCLUDE 'COMMON.CALC'
2393 INCLUDE 'COMMON.CHAIN'
2394 INCLUDE 'COMMON.CONTROL'
2395 INCLUDE 'COMMON.DERIV'
2396 INCLUDE 'COMMON.EMP'
2397 INCLUDE 'COMMON.GEO'
2398 INCLUDE 'COMMON.INTERACT'
2399 INCLUDE 'COMMON.IOUNITS'
2400 INCLUDE 'COMMON.LOCAL'
2401 INCLUDE 'COMMON.NAMES'
2402 INCLUDE 'COMMON.VAR'
2403 double precision scalar, facd3, adler
2404 alphapol2 = alphapol(itypj,itypi)
2405 w1 = wqdip(1,itypi,itypj)
2406 w2 = wqdip(2,itypi,itypj)
2407 pis = sig0head(itypi,itypj)
2408 eps_head = epshead(itypi,itypj)
2409 c!-------------------------------------------------------------------
2410 c! R2 - distance between head of jth side chain and tail of ith sidechain
2413 c! Calculate head-to-tail distances
2414 R2=R2+(chead(k,2)-ctail(k,1))**2
2419 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2420 c! & +dhead(1,1,itypi,itypj))**2))
2421 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2422 c! & +dhead(2,1,itypi,itypj))**2))
2425 c!-------------------------------------------------------------------
2427 sparrow = w1 * Qi * om1
2428 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
2429 ECL = sparrow / Rhead**2.0d0
2430 & - hawk / Rhead**4.0d0
2431 c!-------------------------------------------------------------------
2432 c! derivative of ecl is Gcl
2434 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
2435 & + 4.0d0 * hawk / Rhead**5.0d0
2437 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
2439 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
2440 c--------------------------------------------------------------------
2441 c Polarization energy
2443 MomoFac2 = (1.0d0 - chi2 * sqom1)
2444 RR2 = R2 * R2 / MomoFac2
2445 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
2446 fgb2 = sqrt(RR2 + a12sq * ee2)
2447 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
2449 c! derivative of Epol is Gpol...
2450 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2452 dFGBdR2 = ( (R2 / MomoFac2)
2453 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2455 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2456 & * (2.0d0 - 0.5d0 * ee2) )
2458 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2460 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2463 c!-------------------------------------------------------------------
2465 pom = (pis / Rhead)**6.0d0
2466 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2467 c! derivative of Elj is Glj
2468 dGLJdR = 4.0d0 * eps_head
2469 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2470 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2471 c!-------------------------------------------------------------------
2472 c! Return the results
2473 c! (see comments in Eqq)
2475 erhead(k) = Rhead_distance(k)/Rhead
2476 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2478 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2479 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2480 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2481 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2482 facd1 = d1 * vbld_inv(i+nres)
2483 facd2 = d2 * vbld_inv(j+nres)
2484 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2487 condor = (erhead_tail(k,2)
2488 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2490 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2491 gvdwx(k,i) = gvdwx(k,i)
2493 & - dPOLdR2 * (erhead_tail(k,2)
2494 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2497 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2498 gvdwx(k,j) = gvdwx(k,j)
2500 & + dPOLdR2 * condor
2504 gvdwc(k,i) = gvdwc(k,i)
2505 & - dGCLdR * erhead(k)
2506 & - dPOLdR2 * erhead_tail(k,2)
2507 & - dGLJdR * erhead(k)
2509 gvdwc(k,j) = gvdwc(k,j)
2510 & + dGCLdR * erhead(k)
2511 & + dPOLdR2 * erhead_tail(k,2)
2512 & + dGLJdR * erhead(k)
2519 C--------------------------------------------------------------------
2524 INCLUDE 'DIMENSIONS'
2525 INCLUDE 'DIMENSIONS.ZSCOPT'
2526 INCLUDE 'COMMON.CALC'
2527 INCLUDE 'COMMON.CHAIN'
2528 INCLUDE 'COMMON.CONTROL'
2529 INCLUDE 'COMMON.DERIV'
2530 INCLUDE 'COMMON.EMP'
2531 INCLUDE 'COMMON.GEO'
2532 INCLUDE 'COMMON.INTERACT'
2533 INCLUDE 'COMMON.IOUNITS'
2534 INCLUDE 'COMMON.LOCAL'
2535 INCLUDE 'COMMON.NAMES'
2536 INCLUDE 'COMMON.VAR'
2537 double precision scalar
2538 c! csig = sigiso(itypi,itypj)
2539 w1 = wqdip(1,itypi,itypj)
2540 w2 = wqdip(2,itypi,itypj)
2541 c!-------------------------------------------------------------------
2543 fac = (om12 - 3.0d0 * om1 * om2)
2544 c1 = (w1 / (Rhead**3.0d0)) * fac
2545 c2 = (w2 / Rhead ** 6.0d0)
2546 & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2548 c! write (*,*) "w1 = ", w1
2549 c! write (*,*) "w2 = ", w2
2550 c! write (*,*) "om1 = ", om1
2551 c! write (*,*) "om2 = ", om2
2552 c! write (*,*) "om12 = ", om12
2553 c! write (*,*) "fac = ", fac
2554 c! write (*,*) "c1 = ", c1
2555 c! write (*,*) "c2 = ", c2
2556 c! write (*,*) "Ecl = ", Ecl
2557 c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
2558 c! write (*,*) "c2_2 = ",
2559 c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
2560 c!-------------------------------------------------------------------
2561 c! dervative of ECL is GCL...
2563 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
2564 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0)
2565 & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
2568 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
2569 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2570 & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
2573 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
2574 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
2575 & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
2578 c1 = w1 / (Rhead ** 3.0d0)
2579 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
2581 c!-------------------------------------------------------------------
2582 c! Return the results
2583 c! (see comments in Eqq)
2585 erhead(k) = Rhead_distance(k)/Rhead
2587 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2588 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2589 facd1 = d1 * vbld_inv(i+nres)
2590 facd2 = d2 * vbld_inv(j+nres)
2593 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2594 gvdwx(k,i) = gvdwx(k,i)
2596 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2597 gvdwx(k,j) = gvdwx(k,j)
2600 gvdwc(k,i) = gvdwc(k,i)
2601 & - dGCLdR * erhead(k)
2602 gvdwc(k,j) = gvdwc(k,j)
2603 & + dGCLdR * erhead(k)
2609 c!-------------------------------------------------------------------
2612 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
2615 INCLUDE 'DIMENSIONS'
2616 INCLUDE 'DIMENSIONS.ZSCOPT'
2617 c! itypi, itypj, i, j, k, l, chead,
2618 INCLUDE 'COMMON.CALC'
2620 INCLUDE 'COMMON.CHAIN'
2622 INCLUDE 'COMMON.DERIV'
2623 c! electrostatic gradients-specific variables
2624 INCLUDE 'COMMON.EMP'
2625 c! wquad, dhead, alphiso, alphasur, rborn, epsintab
2626 INCLUDE 'COMMON.INTERACT'
2628 c INCLUDE 'COMMON.MD'
2629 c! io for debug, disable it in final builds
2630 INCLUDE 'COMMON.IOUNITS'
2631 double precision Rb /1.987D-3/
2632 c!-------------------------------------------------------------------
2635 c! what amino acid is the aminoacid j'th?
2637 c! 1/(Gas Constant * Thermostate temperature) = BetaT
2638 c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
2640 c! BetaT = 1.0d0 / (t_bath * Rb)
2641 BetaT = 1.0d0 / (298.0d0 * Rb)
2643 sig0ij = sigma( itypi,itypj )
2644 chi1 = chi( itypi, itypj )
2645 chi2 = chi( itypj, itypi )
2647 chip1 = chipp( itypi, itypj )
2648 chip2 = chipp( itypj, itypi )
2649 chip12 = chip1 * chip2
2650 c! not used by momo potential, but needed by sc_angular which is shared
2651 c! by all energy_potential subroutines
2655 c! location, location, location
2656 xj = c( 1, nres+j ) - xi
2657 yj = c( 2, nres+j ) - yi
2658 zj = c( 3, nres+j ) - zi
2659 dxj = dc_norm( 1, nres+j )
2660 dyj = dc_norm( 2, nres+j )
2661 dzj = dc_norm( 3, nres+j )
2662 c! distance from center of chain(?) to polar/charged head
2663 c! write (*,*) "istate = ", 1
2664 c! write (*,*) "ii = ", 1
2665 c! write (*,*) "jj = ", 1
2666 d1 = dhead(1, 1, itypi, itypj)
2667 d2 = dhead(2, 1, itypi, itypj)
2669 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
2670 c! a12sq = a12sq * a12sq
2671 c! charge of amino acid itypi is...
2676 chis1 = chis(itypi,itypj)
2677 chis2 = chis(itypj,itypi)
2678 chis12 = chis1 * chis2
2679 sig1 = sigmap1(itypi,itypj)
2680 sig2 = sigmap2(itypi,itypj)
2681 c! write (*,*) "sig1 = ", sig1
2682 c! write (*,*) "sig2 = ", sig2
2683 c! alpha factors from Fcav/Gcav
2684 b1 = alphasur(1,itypi,itypj)
2685 b2 = alphasur(2,itypi,itypj)
2686 b3 = alphasur(3,itypi,itypj)
2687 b4 = alphasur(4,itypi,itypj)
2688 c! used to determine whether we want to do quadrupole calculations
2689 wqd = wquad(itypi, itypj)
2691 eps_in = epsintab(itypi,itypj)
2692 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
2693 c! write (*,*) "eps_inout_fac = ", eps_inout_fac
2694 c!-------------------------------------------------------------------
2695 c! tail location and distance calculations
2698 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
2699 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
2701 c! tail distances will be themselves usefull elswhere
2702 c1 (in Gcav, for example)
2703 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
2704 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
2705 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
2707 & (Rtail_distance(1)*Rtail_distance(1))
2708 & + (Rtail_distance(2)*Rtail_distance(2))
2709 & + (Rtail_distance(3)*Rtail_distance(3)))
2710 c!-------------------------------------------------------------------
2711 c! Calculate location and distance between polar heads
2712 c! distance between heads
2713 c! for each one of our three dimensional space...
2715 c! location of polar head is computed by taking hydrophobic centre
2716 c! and moving by a d1 * dc_norm vector
2717 c! see unres publications for very informative images
2718 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
2719 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
2721 c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
2722 c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
2723 Rhead_distance(k) = chead(k,2) - chead(k,1)
2725 c! pitagoras (root of sum of squares)
2727 & (Rhead_distance(1)*Rhead_distance(1))
2728 & + (Rhead_distance(2)*Rhead_distance(2))
2729 & + (Rhead_distance(3)*Rhead_distance(3)))
2730 c!-------------------------------------------------------------------
2731 c! zero everything that should be zero'ed
2744 END SUBROUTINE elgrad_init
2747 C-----------------------------------------------------------------------------
2748 subroutine sc_angular
2749 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2750 C om12. Called by ebp, egb, and egbv.
2752 include 'COMMON.CALC'
2756 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2757 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2758 om12=dxi*dxj+dyi*dyj+dzi*dzj
2760 C Calculate eps1(om12) and its derivative in om12
2761 faceps1=1.0D0-om12*chiom12
2762 faceps1_inv=1.0D0/faceps1
2763 eps1=dsqrt(faceps1_inv)
2764 C Following variable is eps1*deps1/dom12
2765 eps1_om12=faceps1_inv*chiom12
2766 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2771 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2772 sigsq=1.0D0-facsig*faceps1_inv
2773 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2774 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2775 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2776 C Calculate eps2 and its derivatives in om1, om2, and om12.
2779 chipom12=chip12*om12
2780 facp=1.0D0-om12*chipom12
2782 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2783 C Following variable is the square root of eps2
2784 eps2rt=1.0D0-facp1*facp_inv
2785 C Following three variables are the derivatives of the square root of eps
2786 C in om1, om2, and om12.
2787 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2788 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2789 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2790 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2791 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2792 C Calculate whole angle-dependent part of epsilon and contributions
2793 C to its derivatives
2796 C----------------------------------------------------------------------------
2798 implicit real*8 (a-h,o-z)
2799 include 'DIMENSIONS'
2800 include 'DIMENSIONS.ZSCOPT'
2801 include 'COMMON.CHAIN'
2802 include 'COMMON.DERIV'
2803 include 'COMMON.CALC'
2804 double precision dcosom1(3),dcosom2(3)
2805 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2806 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2807 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2808 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2810 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2811 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2814 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2817 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2818 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2819 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2820 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2821 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2822 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2825 C Calculate the components of the gradient in DC and X
2829 gvdwc(l,k)=gvdwc(l,k)+gg(l)
2834 c------------------------------------------------------------------------------
2835 subroutine vec_and_deriv
2836 implicit real*8 (a-h,o-z)
2837 include 'DIMENSIONS'
2838 include 'DIMENSIONS.ZSCOPT'
2839 include 'COMMON.IOUNITS'
2840 include 'COMMON.GEO'
2841 include 'COMMON.VAR'
2842 include 'COMMON.LOCAL'
2843 include 'COMMON.CHAIN'
2844 include 'COMMON.VECTORS'
2845 include 'COMMON.DERIV'
2846 include 'COMMON.INTERACT'
2847 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2848 C Compute the local reference systems. For reference system (i), the
2849 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2850 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2852 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
2853 if (i.eq.nres-1) then
2854 C Case of the last full residue
2855 C Compute the Z-axis
2856 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2857 costh=dcos(pi-theta(nres))
2858 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2863 C Compute the derivatives of uz
2865 uzder(2,1,1)=-dc_norm(3,i-1)
2866 uzder(3,1,1)= dc_norm(2,i-1)
2867 uzder(1,2,1)= dc_norm(3,i-1)
2869 uzder(3,2,1)=-dc_norm(1,i-1)
2870 uzder(1,3,1)=-dc_norm(2,i-1)
2871 uzder(2,3,1)= dc_norm(1,i-1)
2874 uzder(2,1,2)= dc_norm(3,i)
2875 uzder(3,1,2)=-dc_norm(2,i)
2876 uzder(1,2,2)=-dc_norm(3,i)
2878 uzder(3,2,2)= dc_norm(1,i)
2879 uzder(1,3,2)= dc_norm(2,i)
2880 uzder(2,3,2)=-dc_norm(1,i)
2883 C Compute the Y-axis
2886 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2889 C Compute the derivatives of uy
2892 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2893 & -dc_norm(k,i)*dc_norm(j,i-1)
2894 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2896 uyder(j,j,1)=uyder(j,j,1)-costh
2897 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2902 uygrad(l,k,j,i)=uyder(l,k,j)
2903 uzgrad(l,k,j,i)=uzder(l,k,j)
2907 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2908 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2909 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2910 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2914 C Compute the Z-axis
2915 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2916 costh=dcos(pi-theta(i+2))
2917 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2922 C Compute the derivatives of uz
2924 uzder(2,1,1)=-dc_norm(3,i+1)
2925 uzder(3,1,1)= dc_norm(2,i+1)
2926 uzder(1,2,1)= dc_norm(3,i+1)
2928 uzder(3,2,1)=-dc_norm(1,i+1)
2929 uzder(1,3,1)=-dc_norm(2,i+1)
2930 uzder(2,3,1)= dc_norm(1,i+1)
2933 uzder(2,1,2)= dc_norm(3,i)
2934 uzder(3,1,2)=-dc_norm(2,i)
2935 uzder(1,2,2)=-dc_norm(3,i)
2937 uzder(3,2,2)= dc_norm(1,i)
2938 uzder(1,3,2)= dc_norm(2,i)
2939 uzder(2,3,2)=-dc_norm(1,i)
2942 C Compute the Y-axis
2945 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2948 C Compute the derivatives of uy
2951 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2952 & -dc_norm(k,i)*dc_norm(j,i+1)
2953 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2955 uyder(j,j,1)=uyder(j,j,1)-costh
2956 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2961 uygrad(l,k,j,i)=uyder(l,k,j)
2962 uzgrad(l,k,j,i)=uzder(l,k,j)
2966 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2967 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2968 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2969 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2975 vbld_inv_temp(1)=vbld_inv(i+1)
2976 if (i.lt.nres-1) then
2977 vbld_inv_temp(2)=vbld_inv(i+2)
2979 vbld_inv_temp(2)=vbld_inv(i)
2984 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2985 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2993 C-----------------------------------------------------------------------------
2994 subroutine vec_and_deriv_test
2995 implicit real*8 (a-h,o-z)
2996 include 'DIMENSIONS'
2997 include 'DIMENSIONS.ZSCOPT'
2998 include 'COMMON.IOUNITS'
2999 include 'COMMON.GEO'
3000 include 'COMMON.VAR'
3001 include 'COMMON.LOCAL'
3002 include 'COMMON.CHAIN'
3003 include 'COMMON.VECTORS'
3004 dimension uyder(3,3,2),uzder(3,3,2)
3005 C Compute the local reference systems. For reference system (i), the
3006 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
3007 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
3009 if (i.eq.nres-1) then
3010 C Case of the last full residue
3011 C Compute the Z-axis
3012 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
3013 costh=dcos(pi-theta(nres))
3014 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3015 c write (iout,*) 'fac',fac,
3016 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
3017 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
3021 C Compute the derivatives of uz
3023 uzder(2,1,1)=-dc_norm(3,i-1)
3024 uzder(3,1,1)= dc_norm(2,i-1)
3025 uzder(1,2,1)= dc_norm(3,i-1)
3027 uzder(3,2,1)=-dc_norm(1,i-1)
3028 uzder(1,3,1)=-dc_norm(2,i-1)
3029 uzder(2,3,1)= dc_norm(1,i-1)
3032 uzder(2,1,2)= dc_norm(3,i)
3033 uzder(3,1,2)=-dc_norm(2,i)
3034 uzder(1,2,2)=-dc_norm(3,i)
3036 uzder(3,2,2)= dc_norm(1,i)
3037 uzder(1,3,2)= dc_norm(2,i)
3038 uzder(2,3,2)=-dc_norm(1,i)
3040 C Compute the Y-axis
3042 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
3045 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
3046 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
3047 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
3049 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
3052 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
3053 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
3056 c write (iout,*) 'facy',facy,
3057 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3058 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3060 uy(k,i)=facy*uy(k,i)
3062 C Compute the derivatives of uy
3065 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
3066 & -dc_norm(k,i)*dc_norm(j,i-1)
3067 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3069 c uyder(j,j,1)=uyder(j,j,1)-costh
3070 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
3071 uyder(j,j,1)=uyder(j,j,1)
3072 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
3073 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
3079 uygrad(l,k,j,i)=uyder(l,k,j)
3080 uzgrad(l,k,j,i)=uzder(l,k,j)
3084 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3085 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3086 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3087 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3090 C Compute the Z-axis
3091 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
3092 costh=dcos(pi-theta(i+2))
3093 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3094 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
3098 C Compute the derivatives of uz
3100 uzder(2,1,1)=-dc_norm(3,i+1)
3101 uzder(3,1,1)= dc_norm(2,i+1)
3102 uzder(1,2,1)= dc_norm(3,i+1)
3104 uzder(3,2,1)=-dc_norm(1,i+1)
3105 uzder(1,3,1)=-dc_norm(2,i+1)
3106 uzder(2,3,1)= dc_norm(1,i+1)
3109 uzder(2,1,2)= dc_norm(3,i)
3110 uzder(3,1,2)=-dc_norm(2,i)
3111 uzder(1,2,2)=-dc_norm(3,i)
3113 uzder(3,2,2)= dc_norm(1,i)
3114 uzder(1,3,2)= dc_norm(2,i)
3115 uzder(2,3,2)=-dc_norm(1,i)
3117 C Compute the Y-axis
3119 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
3120 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
3121 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
3123 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
3126 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
3127 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
3130 c write (iout,*) 'facy',facy,
3131 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3132 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
3134 uy(k,i)=facy*uy(k,i)
3136 C Compute the derivatives of uy
3139 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
3140 & -dc_norm(k,i)*dc_norm(j,i+1)
3141 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3143 c uyder(j,j,1)=uyder(j,j,1)-costh
3144 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
3145 uyder(j,j,1)=uyder(j,j,1)
3146 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
3147 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
3153 uygrad(l,k,j,i)=uyder(l,k,j)
3154 uzgrad(l,k,j,i)=uzder(l,k,j)
3158 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3159 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3160 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3161 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
3168 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
3169 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
3176 C-----------------------------------------------------------------------------
3177 subroutine check_vecgrad
3178 implicit real*8 (a-h,o-z)
3179 include 'DIMENSIONS'
3180 include 'DIMENSIONS.ZSCOPT'
3181 include 'COMMON.IOUNITS'
3182 include 'COMMON.GEO'
3183 include 'COMMON.VAR'
3184 include 'COMMON.LOCAL'
3185 include 'COMMON.CHAIN'
3186 include 'COMMON.VECTORS'
3187 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
3188 dimension uyt(3,maxres),uzt(3,maxres)
3189 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
3190 double precision delta /1.0d-7/
3193 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
3194 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
3195 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
3196 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
3197 cd & (dc_norm(if90,i),if90=1,3)
3198 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
3199 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
3200 cd write(iout,'(a)')
3206 uygradt(l,k,j,i)=uygrad(l,k,j,i)
3207 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
3220 cd write (iout,*) 'i=',i
3222 erij(k)=dc_norm(k,i)
3226 dc_norm(k,i)=erij(k)
3228 dc_norm(j,i)=dc_norm(j,i)+delta
3229 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
3231 c dc_norm(k,i)=dc_norm(k,i)/fac
3233 c write (iout,*) (dc_norm(k,i),k=1,3)
3234 c write (iout,*) (erij(k),k=1,3)
3237 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
3238 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
3239 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
3240 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
3242 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3243 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
3244 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
3247 dc_norm(k,i)=erij(k)
3250 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3251 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
3252 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
3253 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
3254 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
3255 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
3256 cd write (iout,'(a)')
3261 C--------------------------------------------------------------------------
3262 subroutine set_matrices
3263 implicit real*8 (a-h,o-z)
3264 include 'DIMENSIONS'
3265 include 'DIMENSIONS.ZSCOPT'
3266 include 'COMMON.IOUNITS'
3267 include 'COMMON.GEO'
3268 include 'COMMON.VAR'
3269 include 'COMMON.LOCAL'
3270 include 'COMMON.CHAIN'
3271 include 'COMMON.DERIV'
3272 include 'COMMON.INTERACT'
3273 include 'COMMON.CONTACTS'
3274 include 'COMMON.TORSION'
3275 include 'COMMON.VECTORS'
3276 include 'COMMON.FFIELD'
3277 double precision auxvec(2),auxmat(2,2)
3279 C Compute the virtual-bond-torsional-angle dependent quantities needed
3280 C to calculate the el-loc multibody terms of various order.
3283 if (i .lt. nres+1) then
3320 if (i .gt. 3 .and. i .lt. nres+1) then
3321 obrot_der(1,i-2)=-sin1
3322 obrot_der(2,i-2)= cos1
3323 Ugder(1,1,i-2)= sin1
3324 Ugder(1,2,i-2)=-cos1
3325 Ugder(2,1,i-2)=-cos1
3326 Ugder(2,2,i-2)=-sin1
3329 obrot2_der(1,i-2)=-dwasin2
3330 obrot2_der(2,i-2)= dwacos2
3331 Ug2der(1,1,i-2)= dwasin2
3332 Ug2der(1,2,i-2)=-dwacos2
3333 Ug2der(2,1,i-2)=-dwacos2
3334 Ug2der(2,2,i-2)=-dwasin2
3336 obrot_der(1,i-2)=0.0d0
3337 obrot_der(2,i-2)=0.0d0
3338 Ugder(1,1,i-2)=0.0d0
3339 Ugder(1,2,i-2)=0.0d0
3340 Ugder(2,1,i-2)=0.0d0
3341 Ugder(2,2,i-2)=0.0d0
3342 obrot2_der(1,i-2)=0.0d0
3343 obrot2_der(2,i-2)=0.0d0
3344 Ug2der(1,1,i-2)=0.0d0
3345 Ug2der(1,2,i-2)=0.0d0
3346 Ug2der(2,1,i-2)=0.0d0
3347 Ug2der(2,2,i-2)=0.0d0
3349 if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
3350 iti = itortyp(itype(i-2))
3354 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3355 iti1 = itortyp(itype(i-1))
3359 cd write (iout,*) '*******i',i,' iti1',iti
3360 cd write (iout,*) 'b1',b1(:,iti)
3361 cd write (iout,*) 'b2',b2(:,iti)
3362 cd write (iout,*) 'Ug',Ug(:,:,i-2)
3363 if (i .gt. iatel_s+2) then
3364 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
3365 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
3366 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
3367 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
3368 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3369 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
3370 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
3380 DtUg2(l,k,i-2)=0.0d0
3384 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
3385 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
3386 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3387 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
3388 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3389 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
3390 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3392 muder(k,i-2)=Ub2der(k,i-2)
3394 if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3395 iti1 = itortyp(itype(i-1))
3400 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
3402 C Vectors and matrices dependent on a single virtual-bond dihedral.
3403 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
3404 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3405 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3406 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
3407 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
3408 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3409 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3410 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3411 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3412 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
3413 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
3415 C Matrices dependent on two consecutive virtual-bond dihedrals.
3416 C The order of matrices is from left to right.
3418 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3419 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3420 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3421 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3422 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3423 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3424 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3425 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3428 cd iti = itortyp(itype(i))
3431 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3432 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3437 C--------------------------------------------------------------------------
3438 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3440 C This subroutine calculates the average interaction energy and its gradient
3441 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3442 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3443 C The potential depends both on the distance of peptide-group centers and on
3444 C the orientation of the CA-CA virtual bonds.
3446 implicit real*8 (a-h,o-z)
3447 include 'DIMENSIONS'
3448 include 'DIMENSIONS.ZSCOPT'
3449 include 'COMMON.CONTROL'
3450 include 'COMMON.IOUNITS'
3451 include 'COMMON.GEO'
3452 include 'COMMON.VAR'
3453 include 'COMMON.LOCAL'
3454 include 'COMMON.CHAIN'
3455 include 'COMMON.DERIV'
3456 include 'COMMON.INTERACT'
3457 include 'COMMON.CONTACTS'
3458 include 'COMMON.TORSION'
3459 include 'COMMON.VECTORS'
3460 include 'COMMON.FFIELD'
3461 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3462 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3463 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3464 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3465 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
3466 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3467 double precision scal_el /0.5d0/
3469 C 13-go grudnia roku pamietnego...
3470 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3471 & 0.0d0,1.0d0,0.0d0,
3472 & 0.0d0,0.0d0,1.0d0/
3473 cd write(iout,*) 'In EELEC'
3475 cd write(iout,*) 'Type',i
3476 cd write(iout,*) 'B1',B1(:,i)
3477 cd write(iout,*) 'B2',B2(:,i)
3478 cd write(iout,*) 'CC',CC(:,:,i)
3479 cd write(iout,*) 'DD',DD(:,:,i)
3480 cd write(iout,*) 'EE',EE(:,:,i)
3482 cd call check_vecgrad
3484 if (icheckgrad.eq.1) then
3486 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3488 dc_norm(k,i)=dc(k,i)*fac
3490 c write (iout,*) 'i',i,' fac',fac
3493 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3494 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3495 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3496 cd if (wel_loc.gt.0.0d0) then
3497 if (icheckgrad.eq.1) then
3498 call vec_and_deriv_test
3505 cd write (iout,*) 'i=',i
3507 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3510 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3511 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3524 cd print '(a)','Enter EELEC'
3525 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3527 gel_loc_loc(i)=0.0d0
3530 do i=iatel_s,iatel_e
3531 if (itel(i).eq.0) goto 1215
3535 dx_normi=dc_norm(1,i)
3536 dy_normi=dc_norm(2,i)
3537 dz_normi=dc_norm(3,i)
3538 xmedi=c(1,i)+0.5d0*dxi
3539 ymedi=c(2,i)+0.5d0*dyi
3540 zmedi=c(3,i)+0.5d0*dzi
3542 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3543 do j=ielstart(i),ielend(i)
3544 if (itel(j).eq.0) goto 1216
3548 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3549 aaa=app(iteli,itelj)
3550 bbb=bpp(iteli,itelj)
3551 C Diagnostics only!!!
3557 ael6i=ael6(iteli,itelj)
3558 ael3i=ael3(iteli,itelj)
3562 dx_normj=dc_norm(1,j)
3563 dy_normj=dc_norm(2,j)
3564 dz_normj=dc_norm(3,j)
3565 xj=c(1,j)+0.5D0*dxj-xmedi
3566 yj=c(2,j)+0.5D0*dyj-ymedi
3567 zj=c(3,j)+0.5D0*dzj-zmedi
3568 rij=xj*xj+yj*yj+zj*zj
3574 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3575 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3576 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3577 fac=cosa-3.0D0*cosb*cosg
3579 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3580 if (j.eq.i+2) ev1=scal_el*ev1
3585 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3588 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
3589 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3590 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3593 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3594 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3595 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3596 cd & xmedi,ymedi,zmedi,xj,yj,zj
3598 C Calculate contributions to the Cartesian gradient.
3601 facvdw=-6*rrmij*(ev1+evdwij)
3602 facel=-3*rrmij*(el1+eesij)
3609 * Radial derivatives. First process both termini of the fragment (i,j)
3616 gelc(k,i)=gelc(k,i)+ghalf
3617 gelc(k,j)=gelc(k,j)+ghalf
3620 * Loop over residues i+1 thru j-1.
3624 gelc(l,k)=gelc(l,k)+ggg(l)
3632 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3633 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3636 * Loop over residues i+1 thru j-1.
3640 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3647 fac=-3*rrmij*(facvdw+facvdw+facel)
3653 * Radial derivatives. First process both termini of the fragment (i,j)
3660 gelc(k,i)=gelc(k,i)+ghalf
3661 gelc(k,j)=gelc(k,j)+ghalf
3664 * Loop over residues i+1 thru j-1.
3668 gelc(l,k)=gelc(l,k)+ggg(l)
3675 ecosa=2.0D0*fac3*fac1+fac4
3678 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3679 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3681 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3682 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3684 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3685 cd & (dcosg(k),k=1,3)
3687 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3691 gelc(k,i)=gelc(k,i)+ghalf
3692 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3693 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3694 gelc(k,j)=gelc(k,j)+ghalf
3695 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3696 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3700 gelc(l,k)=gelc(l,k)+ggg(l)
3705 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3706 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3707 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3709 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3710 C energy of a peptide unit is assumed in the form of a second-order
3711 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3712 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3713 C are computed for EVERY pair of non-contiguous peptide groups.
3715 if (j.lt.nres-1) then
3726 muij(kkk)=mu(k,i)*mu(l,j)
3729 cd write (iout,*) 'EELEC: i',i,' j',j
3730 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3731 cd write(iout,*) 'muij',muij
3732 ury=scalar(uy(1,i),erij)
3733 urz=scalar(uz(1,i),erij)
3734 vry=scalar(uy(1,j),erij)
3735 vrz=scalar(uz(1,j),erij)
3736 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3737 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3738 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3739 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3740 C For diagnostics only
3745 fac=dsqrt(-ael6i)*r3ij
3746 cd write (2,*) 'fac=',fac
3747 C For diagnostics only
3753 cd write (iout,'(4i5,4f10.5)')
3754 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3755 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3756 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
3757 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
3758 cd write (iout,'(4f10.5)')
3759 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3760 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3761 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3762 cd write (iout,'(2i3,9f10.5/)') i,j,
3763 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3765 C Derivatives of the elements of A in virtual-bond vectors
3766 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3773 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3774 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3775 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3776 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3777 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3778 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3779 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3780 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3781 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3782 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3783 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3784 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3794 C Compute radial contributions to the gradient
3816 C Add the contributions coming from er
3819 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3820 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3821 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3822 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3825 C Derivatives in DC(i)
3826 ghalf1=0.5d0*agg(k,1)
3827 ghalf2=0.5d0*agg(k,2)
3828 ghalf3=0.5d0*agg(k,3)
3829 ghalf4=0.5d0*agg(k,4)
3830 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3831 & -3.0d0*uryg(k,2)*vry)+ghalf1
3832 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3833 & -3.0d0*uryg(k,2)*vrz)+ghalf2
3834 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3835 & -3.0d0*urzg(k,2)*vry)+ghalf3
3836 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3837 & -3.0d0*urzg(k,2)*vrz)+ghalf4
3838 C Derivatives in DC(i+1)
3839 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3840 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
3841 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3842 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
3843 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3844 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
3845 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3846 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
3847 C Derivatives in DC(j)
3848 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3849 & -3.0d0*vryg(k,2)*ury)+ghalf1
3850 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3851 & -3.0d0*vrzg(k,2)*ury)+ghalf2
3852 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3853 & -3.0d0*vryg(k,2)*urz)+ghalf3
3854 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3855 & -3.0d0*vrzg(k,2)*urz)+ghalf4
3856 C Derivatives in DC(j+1) or DC(nres-1)
3857 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3858 & -3.0d0*vryg(k,3)*ury)
3859 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3860 & -3.0d0*vrzg(k,3)*ury)
3861 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3862 & -3.0d0*vryg(k,3)*urz)
3863 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3864 & -3.0d0*vrzg(k,3)*urz)
3869 C Derivatives in DC(i+1)
3870 cd aggi1(k,1)=agg(k,1)
3871 cd aggi1(k,2)=agg(k,2)
3872 cd aggi1(k,3)=agg(k,3)
3873 cd aggi1(k,4)=agg(k,4)
3874 C Derivatives in DC(j)
3879 C Derivatives in DC(j+1)
3884 if (j.eq.nres-1 .and. i.lt.j-2) then
3886 aggj1(k,l)=aggj1(k,l)+agg(k,l)
3887 cd aggj1(k,l)=agg(k,l)
3893 C Check the loc-el terms by numerical integration
3903 aggi(k,l)=-aggi(k,l)
3904 aggi1(k,l)=-aggi1(k,l)
3905 aggj(k,l)=-aggj(k,l)
3906 aggj1(k,l)=-aggj1(k,l)
3909 if (j.lt.nres-1) then
3915 aggi(k,l)=-aggi(k,l)
3916 aggi1(k,l)=-aggi1(k,l)
3917 aggj(k,l)=-aggj(k,l)
3918 aggj1(k,l)=-aggj1(k,l)
3929 aggi(k,l)=-aggi(k,l)
3930 aggi1(k,l)=-aggi1(k,l)
3931 aggj(k,l)=-aggj(k,l)
3932 aggj1(k,l)=-aggj1(k,l)
3938 IF (wel_loc.gt.0.0d0) THEN
3939 C Contribution to the local-electrostatic energy coming from the i-j pair
3940 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3942 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3943 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3944 eel_loc=eel_loc+eel_loc_ij
3945 C Partial derivatives in virtual-bond dihedral angles gamma
3948 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3949 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3950 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3951 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3952 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3953 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3954 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
3955 cd write(iout,*) 'agg ',agg
3956 cd write(iout,*) 'aggi ',aggi
3957 cd write(iout,*) 'aggi1',aggi1
3958 cd write(iout,*) 'aggj ',aggj
3959 cd write(iout,*) 'aggj1',aggj1
3961 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3963 ggg(l)=agg(l,1)*muij(1)+
3964 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3968 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3971 C Remaining derivatives of eello
3973 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3974 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3975 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3976 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3977 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3978 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3979 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3980 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3984 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3985 C Contributions from turns
3990 call eturn34(i,j,eello_turn3,eello_turn4)
3992 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3993 if (j.gt.i+1 .and. num_conti.le.maxconts) then
3995 C Calculate the contact function. The ith column of the array JCONT will
3996 C contain the numbers of atoms that make contacts with the atom I (of numbers
3997 C greater than I). The arrays FACONT and GACONT will contain the values of
3998 C the contact function and its derivative.
3999 c r0ij=1.02D0*rpp(iteli,itelj)
4000 c r0ij=1.11D0*rpp(iteli,itelj)
4001 r0ij=2.20D0*rpp(iteli,itelj)
4002 c r0ij=1.55D0*rpp(iteli,itelj)
4003 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4004 if (fcont.gt.0.0D0) then
4005 num_conti=num_conti+1
4006 if (num_conti.gt.maxconts) then
4007 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4008 & ' will skip next contacts for this conf.'
4010 jcont_hb(num_conti,i)=j
4011 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4012 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4013 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4015 d_cont(num_conti,i)=rij
4016 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4017 C --- Electrostatic-interaction matrix ---
4018 a_chuj(1,1,num_conti,i)=a22
4019 a_chuj(1,2,num_conti,i)=a23
4020 a_chuj(2,1,num_conti,i)=a32
4021 a_chuj(2,2,num_conti,i)=a33
4022 C --- Gradient of rij
4024 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4027 c a_chuj(1,1,num_conti,i)=-0.61d0
4028 c a_chuj(1,2,num_conti,i)= 0.4d0
4029 c a_chuj(2,1,num_conti,i)= 0.65d0
4030 c a_chuj(2,2,num_conti,i)= 0.50d0
4031 c else if (i.eq.2) then
4032 c a_chuj(1,1,num_conti,i)= 0.0d0
4033 c a_chuj(1,2,num_conti,i)= 0.0d0
4034 c a_chuj(2,1,num_conti,i)= 0.0d0
4035 c a_chuj(2,2,num_conti,i)= 0.0d0
4037 C --- and its gradients
4038 cd write (iout,*) 'i',i,' j',j
4040 cd write (iout,*) 'iii 1 kkk',kkk
4041 cd write (iout,*) agg(kkk,:)
4044 cd write (iout,*) 'iii 2 kkk',kkk
4045 cd write (iout,*) aggi(kkk,:)
4048 cd write (iout,*) 'iii 3 kkk',kkk
4049 cd write (iout,*) aggi1(kkk,:)
4052 cd write (iout,*) 'iii 4 kkk',kkk
4053 cd write (iout,*) aggj(kkk,:)
4056 cd write (iout,*) 'iii 5 kkk',kkk
4057 cd write (iout,*) aggj1(kkk,:)
4064 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4065 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4066 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4067 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4068 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4070 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
4076 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4077 C Calculate contact energies
4079 wij=cosa-3.0D0*cosb*cosg
4082 c fac3=dsqrt(-ael6i)/r0ij**3
4083 fac3=dsqrt(-ael6i)*r3ij
4084 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4085 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4087 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4088 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4089 C Diagnostics. Comment out or remove after debugging!
4090 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4091 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4092 c ees0m(num_conti,i)=0.0D0
4094 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4095 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4096 facont_hb(num_conti,i)=fcont
4098 C Angular derivatives of the contact function
4099 ees0pij1=fac3/ees0pij
4100 ees0mij1=fac3/ees0mij
4101 fac3p=-3.0D0*fac3*rrmij
4102 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4103 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4105 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4106 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4107 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4108 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4109 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4110 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4111 ecosap=ecosa1+ecosa2
4112 ecosbp=ecosb1+ecosb2
4113 ecosgp=ecosg1+ecosg2
4114 ecosam=ecosa1-ecosa2
4115 ecosbm=ecosb1-ecosb2
4116 ecosgm=ecosg1-ecosg2
4125 fprimcont=fprimcont/rij
4126 cd facont_hb(num_conti,i)=1.0D0
4127 C Following line is for diagnostics.
4130 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4131 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4134 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4135 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4137 gggp(1)=gggp(1)+ees0pijp*xj
4138 gggp(2)=gggp(2)+ees0pijp*yj
4139 gggp(3)=gggp(3)+ees0pijp*zj
4140 gggm(1)=gggm(1)+ees0mijp*xj
4141 gggm(2)=gggm(2)+ees0mijp*yj
4142 gggm(3)=gggm(3)+ees0mijp*zj
4143 C Derivatives due to the contact function
4144 gacont_hbr(1,num_conti,i)=fprimcont*xj
4145 gacont_hbr(2,num_conti,i)=fprimcont*yj
4146 gacont_hbr(3,num_conti,i)=fprimcont*zj
4148 ghalfp=0.5D0*gggp(k)
4149 ghalfm=0.5D0*gggm(k)
4150 gacontp_hb1(k,num_conti,i)=ghalfp
4151 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4152 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4153 gacontp_hb2(k,num_conti,i)=ghalfp
4154 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4155 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4156 gacontp_hb3(k,num_conti,i)=gggp(k)
4157 gacontm_hb1(k,num_conti,i)=ghalfm
4158 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4159 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4160 gacontm_hb2(k,num_conti,i)=ghalfm
4161 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4162 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4163 gacontm_hb3(k,num_conti,i)=gggm(k)
4166 C Diagnostics. Comment out or remove after debugging!
4168 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4169 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4170 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4171 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4172 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4173 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4176 endif ! num_conti.le.maxconts
4181 num_cont_hb(i)=num_conti
4185 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
4186 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
4188 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
4189 ccc eel_loc=eel_loc+eello_turn3
4192 C-----------------------------------------------------------------------------
4193 subroutine eturn34(i,j,eello_turn3,eello_turn4)
4194 C Third- and fourth-order contributions from turns
4195 implicit real*8 (a-h,o-z)
4196 include 'DIMENSIONS'
4197 include 'DIMENSIONS.ZSCOPT'
4198 include 'COMMON.IOUNITS'
4199 include 'COMMON.GEO'
4200 include 'COMMON.VAR'
4201 include 'COMMON.LOCAL'
4202 include 'COMMON.CHAIN'
4203 include 'COMMON.DERIV'
4204 include 'COMMON.INTERACT'
4205 include 'COMMON.CONTACTS'
4206 include 'COMMON.TORSION'
4207 include 'COMMON.VECTORS'
4208 include 'COMMON.FFIELD'
4210 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4211 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4212 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
4213 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4214 & aggj(3,4),aggj1(3,4),a_temp(2,2)
4215 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
4217 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4219 C Third-order contributions
4226 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4227 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4228 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4229 call transpose2(auxmat(1,1),auxmat1(1,1))
4230 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4231 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4232 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4233 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4234 cd & ' eello_turn3_num',4*eello_turn3_num
4236 C Derivatives in gamma(i)
4237 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4238 call transpose2(auxmat2(1,1),pizda(1,1))
4239 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4240 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4241 C Derivatives in gamma(i+1)
4242 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4243 call transpose2(auxmat2(1,1),pizda(1,1))
4244 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
4245 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4246 & +0.5d0*(pizda(1,1)+pizda(2,2))
4247 C Cartesian derivatives
4249 a_temp(1,1)=aggi(l,1)
4250 a_temp(1,2)=aggi(l,2)
4251 a_temp(2,1)=aggi(l,3)
4252 a_temp(2,2)=aggi(l,4)
4253 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4254 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4255 & +0.5d0*(pizda(1,1)+pizda(2,2))
4256 a_temp(1,1)=aggi1(l,1)
4257 a_temp(1,2)=aggi1(l,2)
4258 a_temp(2,1)=aggi1(l,3)
4259 a_temp(2,2)=aggi1(l,4)
4260 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4261 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4262 & +0.5d0*(pizda(1,1)+pizda(2,2))
4263 a_temp(1,1)=aggj(l,1)
4264 a_temp(1,2)=aggj(l,2)
4265 a_temp(2,1)=aggj(l,3)
4266 a_temp(2,2)=aggj(l,4)
4267 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4268 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4269 & +0.5d0*(pizda(1,1)+pizda(2,2))
4270 a_temp(1,1)=aggj1(l,1)
4271 a_temp(1,2)=aggj1(l,2)
4272 a_temp(2,1)=aggj1(l,3)
4273 a_temp(2,2)=aggj1(l,4)
4274 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4275 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4276 & +0.5d0*(pizda(1,1)+pizda(2,2))
4279 else if (j.eq.i+3) then
4280 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4282 C Fourth-order contributions
4290 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4291 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4292 iti1=itortyp(itype(i+1))
4293 iti2=itortyp(itype(i+2))
4294 iti3=itortyp(itype(i+3))
4295 call transpose2(EUg(1,1,i+1),e1t(1,1))
4296 call transpose2(Eug(1,1,i+2),e2t(1,1))
4297 call transpose2(Eug(1,1,i+3),e3t(1,1))
4298 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4299 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4300 s1=scalar2(b1(1,iti2),auxvec(1))
4301 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4302 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4303 s2=scalar2(b1(1,iti1),auxvec(1))
4304 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4305 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4306 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4307 eello_turn4=eello_turn4-(s1+s2+s3)
4308 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4309 cd & ' eello_turn4_num',8*eello_turn4_num
4310 C Derivatives in gamma(i)
4312 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4313 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4314 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4315 s1=scalar2(b1(1,iti2),auxvec(1))
4316 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4317 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4318 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4319 C Derivatives in gamma(i+1)
4320 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4321 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4322 s2=scalar2(b1(1,iti1),auxvec(1))
4323 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4324 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4325 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4326 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4327 C Derivatives in gamma(i+2)
4328 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4329 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4330 s1=scalar2(b1(1,iti2),auxvec(1))
4331 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4332 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4333 s2=scalar2(b1(1,iti1),auxvec(1))
4334 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
4335 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4336 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4337 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4338 C Cartesian derivatives
4339 C Derivatives of this turn contributions in DC(i+2)
4340 if (j.lt.nres-1) then
4342 a_temp(1,1)=agg(l,1)
4343 a_temp(1,2)=agg(l,2)
4344 a_temp(2,1)=agg(l,3)
4345 a_temp(2,2)=agg(l,4)
4346 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4347 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4348 s1=scalar2(b1(1,iti2),auxvec(1))
4349 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4350 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4351 s2=scalar2(b1(1,iti1),auxvec(1))
4352 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4353 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4354 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4356 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4359 C Remaining derivatives of this turn contribution
4361 a_temp(1,1)=aggi(l,1)
4362 a_temp(1,2)=aggi(l,2)
4363 a_temp(2,1)=aggi(l,3)
4364 a_temp(2,2)=aggi(l,4)
4365 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4366 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4367 s1=scalar2(b1(1,iti2),auxvec(1))
4368 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4369 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4370 s2=scalar2(b1(1,iti1),auxvec(1))
4371 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4372 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4373 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4374 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4375 a_temp(1,1)=aggi1(l,1)
4376 a_temp(1,2)=aggi1(l,2)
4377 a_temp(2,1)=aggi1(l,3)
4378 a_temp(2,2)=aggi1(l,4)
4379 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4380 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4381 s1=scalar2(b1(1,iti2),auxvec(1))
4382 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4383 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4384 s2=scalar2(b1(1,iti1),auxvec(1))
4385 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4386 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4387 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4388 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4389 a_temp(1,1)=aggj(l,1)
4390 a_temp(1,2)=aggj(l,2)
4391 a_temp(2,1)=aggj(l,3)
4392 a_temp(2,2)=aggj(l,4)
4393 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4394 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4395 s1=scalar2(b1(1,iti2),auxvec(1))
4396 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4397 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4398 s2=scalar2(b1(1,iti1),auxvec(1))
4399 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4400 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4401 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4402 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4403 a_temp(1,1)=aggj1(l,1)
4404 a_temp(1,2)=aggj1(l,2)
4405 a_temp(2,1)=aggj1(l,3)
4406 a_temp(2,2)=aggj1(l,4)
4407 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4408 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4409 s1=scalar2(b1(1,iti2),auxvec(1))
4410 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4411 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4412 s2=scalar2(b1(1,iti1),auxvec(1))
4413 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4414 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4415 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4416 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4422 C-----------------------------------------------------------------------------
4423 subroutine vecpr(u,v,w)
4424 implicit real*8(a-h,o-z)
4425 dimension u(3),v(3),w(3)
4426 w(1)=u(2)*v(3)-u(3)*v(2)
4427 w(2)=-u(1)*v(3)+u(3)*v(1)
4428 w(3)=u(1)*v(2)-u(2)*v(1)
4431 C-----------------------------------------------------------------------------
4432 subroutine unormderiv(u,ugrad,unorm,ungrad)
4433 C This subroutine computes the derivatives of a normalized vector u, given
4434 C the derivatives computed without normalization conditions, ugrad. Returns
4437 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4438 double precision vec(3)
4439 double precision scalar
4441 c write (2,*) 'ugrad',ugrad
4444 vec(i)=scalar(ugrad(1,i),u(1))
4446 c write (2,*) 'vec',vec
4449 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4452 c write (2,*) 'ungrad',ungrad
4455 C-----------------------------------------------------------------------------
4456 subroutine escp(evdw2,evdw2_14)
4458 C This subroutine calculates the excluded-volume interaction energy between
4459 C peptide-group centers and side chains and its gradient in virtual-bond and
4460 C side-chain vectors.
4462 implicit real*8 (a-h,o-z)
4463 include 'DIMENSIONS'
4464 include 'DIMENSIONS.ZSCOPT'
4465 include 'COMMON.GEO'
4466 include 'COMMON.VAR'
4467 include 'COMMON.LOCAL'
4468 include 'COMMON.CHAIN'
4469 include 'COMMON.DERIV'
4470 include 'COMMON.INTERACT'
4471 include 'COMMON.FFIELD'
4472 include 'COMMON.IOUNITS'
4476 cd print '(a)','Enter ESCP'
4477 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
4478 c & ' scal14',scal14
4479 do i=iatscp_s,iatscp_e
4481 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
4482 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
4483 if (iteli.eq.0) goto 1225
4484 xi=0.5D0*(c(1,i)+c(1,i+1))
4485 yi=0.5D0*(c(2,i)+c(2,i+1))
4486 zi=0.5D0*(c(3,i)+c(3,i+1))
4488 do iint=1,nscp_gr(i)
4490 do j=iscpstart(i,iint),iscpend(i,iint)
4492 C Uncomment following three lines for SC-p interactions
4496 C Uncomment following three lines for Ca-p interactions
4500 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4502 e1=fac*fac*aad(itypj,iteli)
4503 e2=fac*bad(itypj,iteli)
4504 if (iabs(j-i) .le. 2) then
4507 evdw2_14=evdw2_14+e1+e2
4510 c write (iout,*) i,j,evdwij
4514 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4516 fac=-(evdwij+e1)*rrij
4521 cd write (iout,*) 'j<i'
4522 C Uncomment following three lines for SC-p interactions
4524 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4527 cd write (iout,*) 'j>i'
4530 C Uncomment following line for SC-p interactions
4531 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4535 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4539 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4540 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4543 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4553 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4554 gradx_scp(j,i)=expon*gradx_scp(j,i)
4557 C******************************************************************************
4561 C To save time the factor EXPON has been extracted from ALL components
4562 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4565 C******************************************************************************
4568 C--------------------------------------------------------------------------
4569 subroutine edis(ehpb)
4571 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4573 implicit real*8 (a-h,o-z)
4574 include 'DIMENSIONS'
4575 include 'DIMENSIONS.ZSCOPT'
4576 include 'COMMON.SBRIDGE'
4577 include 'COMMON.CHAIN'
4578 include 'COMMON.DERIV'
4579 include 'COMMON.VAR'
4580 include 'COMMON.INTERACT'
4583 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
4584 cd print *,'link_start=',link_start,' link_end=',link_end
4585 if (link_end.eq.0) return
4586 do i=link_start,link_end
4587 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4588 C CA-CA distance used in regularization of structure.
4591 C iii and jjj point to the residues for which the distance is assigned.
4592 if (ii.gt.nres) then
4599 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4600 C distance and angle dependent SS bond potential.
4601 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4602 call ssbond_ene(iii,jjj,eij)
4605 C Calculate the distance between the two points and its difference from the
4609 C Get the force constant corresponding to this distance.
4611 C Calculate the contribution to energy.
4612 ehpb=ehpb+waga*rdis*rdis
4614 C Evaluate gradient.
4617 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4618 cd & ' waga=',waga,' fac=',fac
4620 ggg(j)=fac*(c(j,jj)-c(j,ii))
4622 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4623 C If this is a SC-SC distance, we need to calculate the contributions to the
4624 C Cartesian gradient in the SC vectors (ghpbx).
4627 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4628 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4633 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4641 C--------------------------------------------------------------------------
4642 subroutine ssbond_ene(i,j,eij)
4644 C Calculate the distance and angle dependent SS-bond potential energy
4645 C using a free-energy function derived based on RHF/6-31G** ab initio
4646 C calculations of diethyl disulfide.
4648 C A. Liwo and U. Kozlowska, 11/24/03
4650 implicit real*8 (a-h,o-z)
4651 include 'DIMENSIONS'
4652 include 'DIMENSIONS.ZSCOPT'
4653 include 'COMMON.SBRIDGE'
4654 include 'COMMON.CHAIN'
4655 include 'COMMON.DERIV'
4656 include 'COMMON.LOCAL'
4657 include 'COMMON.INTERACT'
4658 include 'COMMON.VAR'
4659 include 'COMMON.IOUNITS'
4660 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4665 dxi=dc_norm(1,nres+i)
4666 dyi=dc_norm(2,nres+i)
4667 dzi=dc_norm(3,nres+i)
4668 dsci_inv=dsc_inv(itypi)
4670 dscj_inv=dsc_inv(itypj)
4674 dxj=dc_norm(1,nres+j)
4675 dyj=dc_norm(2,nres+j)
4676 dzj=dc_norm(3,nres+j)
4677 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4682 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4683 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4684 om12=dxi*dxj+dyi*dyj+dzi*dzj
4686 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4687 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4693 deltat12=om2-om1+2.0d0
4695 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4696 & +akct*deltad*deltat12
4697 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4698 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4699 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4700 c & " deltat12",deltat12," eij",eij
4701 ed=2*akcm*deltad+akct*deltat12
4703 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4704 eom1=-2*akth*deltat1-pom1-om2*pom2
4705 eom2= 2*akth*deltat2+pom1-om1*pom2
4708 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4711 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4712 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4713 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4714 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4717 C Calculate the components of the gradient in DC and X
4721 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4726 C--------------------------------------------------------------------------
4727 subroutine ebond(estr)
4729 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4731 implicit real*8 (a-h,o-z)
4732 include 'DIMENSIONS'
4733 include 'DIMENSIONS.ZSCOPT'
4734 include 'COMMON.LOCAL'
4735 include 'COMMON.GEO'
4736 include 'COMMON.INTERACT'
4737 include 'COMMON.DERIV'
4738 include 'COMMON.VAR'
4739 include 'COMMON.CHAIN'
4740 include 'COMMON.IOUNITS'
4741 include 'COMMON.NAMES'
4742 include 'COMMON.FFIELD'
4743 include 'COMMON.CONTROL'
4744 double precision u(3),ud(3)
4747 diff = vbld(i)-vbldp0
4748 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4751 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4756 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4763 diff=vbld(i+nres)-vbldsc0(1,iti)
4764 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4765 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4766 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4768 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4772 diff=vbld(i+nres)-vbldsc0(j,iti)
4773 ud(j)=aksc(j,iti)*diff
4774 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4788 uprod2=uprod2*u(k)*u(k)
4792 usumsqder=usumsqder+ud(j)*uprod2
4794 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4795 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4796 estr=estr+uprod/usum
4798 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4806 C--------------------------------------------------------------------------
4807 subroutine ebend(etheta)
4809 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4810 C angles gamma and its derivatives in consecutive thetas and gammas.
4812 implicit real*8 (a-h,o-z)
4813 include 'DIMENSIONS'
4814 include 'DIMENSIONS.ZSCOPT'
4815 include 'COMMON.LOCAL'
4816 include 'COMMON.GEO'
4817 include 'COMMON.INTERACT'
4818 include 'COMMON.DERIV'
4819 include 'COMMON.VAR'
4820 include 'COMMON.CHAIN'
4821 include 'COMMON.IOUNITS'
4822 include 'COMMON.NAMES'
4823 include 'COMMON.FFIELD'
4824 common /calcthet/ term1,term2,termm,diffak,ratak,
4825 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4826 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4827 double precision y(2),z(2)
4829 time11=dexp(-2*time)
4832 c write (iout,*) "nres",nres
4833 c write (*,'(a,i2)') 'EBEND ICG=',icg
4834 c write (iout,*) ithet_start,ithet_end
4835 do i=ithet_start,ithet_end
4836 C Zero the energy function and its derivative at 0 or pi.
4837 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4839 c if (i.gt.ithet_start .and.
4840 c & (itel(i-1).eq.0 .or. itel(i-2).eq.0)) goto 1215
4841 c if (i.gt.3 .and. (i.le.4 .or. itel(i-3).ne.0)) then
4849 c if (i.lt.nres .and. itel(i).ne.0) then
4861 call proc_proc(phii,icrc)
4862 if (icrc.eq.1) phii=150.0
4876 call proc_proc(phii1,icrc)
4877 if (icrc.eq.1) phii1=150.0
4889 C Calculate the "mean" value of theta from the part of the distribution
4890 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4891 C In following comments this theta will be referred to as t_c.
4892 thet_pred_mean=0.0d0
4896 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4898 c write (iout,*) "thet_pred_mean",thet_pred_mean
4899 dthett=thet_pred_mean*ssd
4900 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4901 c write (iout,*) "thet_pred_mean",thet_pred_mean
4902 C Derivatives of the "mean" values in gamma1 and gamma2.
4903 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4904 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4905 if (theta(i).gt.pi-delta) then
4906 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4908 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4909 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4910 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4912 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4914 else if (theta(i).lt.delta) then
4915 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4916 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4917 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4919 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4920 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4923 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4926 etheta=etheta+ethetai
4927 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4928 c & rad2deg*phii,rad2deg*phii1,ethetai
4929 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4930 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4931 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4934 C Ufff.... We've done all this!!!
4937 C---------------------------------------------------------------------------
4938 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4940 implicit real*8 (a-h,o-z)
4941 include 'DIMENSIONS'
4942 include 'DIMENSIONS.ZSCOPT'
4943 include 'COMMON.LOCAL'
4944 include 'COMMON.IOUNITS'
4945 common /calcthet/ term1,term2,termm,diffak,ratak,
4946 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4947 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4948 C Calculate the contributions to both Gaussian lobes.
4949 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4950 C The "polynomial part" of the "standard deviation" of this part of
4954 sig=sig*thet_pred_mean+polthet(j,it)
4956 C Derivative of the "interior part" of the "standard deviation of the"
4957 C gamma-dependent Gaussian lobe in t_c.
4958 sigtc=3*polthet(3,it)
4960 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4963 C Set the parameters of both Gaussian lobes of the distribution.
4964 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4965 fac=sig*sig+sigc0(it)
4968 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4969 sigsqtc=-4.0D0*sigcsq*sigtc
4970 c print *,i,sig,sigtc,sigsqtc
4971 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4972 sigtc=-sigtc/(fac*fac)
4973 C Following variable is sigma(t_c)**(-2)
4974 sigcsq=sigcsq*sigcsq
4976 sig0inv=1.0D0/sig0i**2
4977 delthec=thetai-thet_pred_mean
4978 delthe0=thetai-theta0i
4979 term1=-0.5D0*sigcsq*delthec*delthec
4980 term2=-0.5D0*sig0inv*delthe0*delthe0
4981 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4982 C NaNs in taking the logarithm. We extract the largest exponent which is added
4983 C to the energy (this being the log of the distribution) at the end of energy
4984 C term evaluation for this virtual-bond angle.
4985 if (term1.gt.term2) then
4987 term2=dexp(term2-termm)
4991 term1=dexp(term1-termm)
4994 C The ratio between the gamma-independent and gamma-dependent lobes of
4995 C the distribution is a Gaussian function of thet_pred_mean too.
4996 diffak=gthet(2,it)-thet_pred_mean
4997 ratak=diffak/gthet(3,it)**2
4998 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4999 C Let's differentiate it in thet_pred_mean NOW.
5001 C Now put together the distribution terms to make complete distribution.
5002 termexp=term1+ak*term2
5003 termpre=sigc+ak*sig0i
5004 C Contribution of the bending energy from this theta is just the -log of
5005 C the sum of the contributions from the two lobes and the pre-exponential
5006 C factor. Simple enough, isn't it?
5007 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5008 C NOW the derivatives!!!
5009 C 6/6/97 Take into account the deformation.
5010 E_theta=(delthec*sigcsq*term1
5011 & +ak*delthe0*sig0inv*term2)/termexp
5012 E_tc=((sigtc+aktc*sig0i)/termpre
5013 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5014 & aktc*term2)/termexp)
5017 c-----------------------------------------------------------------------------
5018 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5019 implicit real*8 (a-h,o-z)
5020 include 'DIMENSIONS'
5021 include 'DIMENSIONS.ZSCOPT'
5022 include 'COMMON.LOCAL'
5023 include 'COMMON.IOUNITS'
5024 common /calcthet/ term1,term2,termm,diffak,ratak,
5025 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5026 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5027 delthec=thetai-thet_pred_mean
5028 delthe0=thetai-theta0i
5029 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5030 t3 = thetai-thet_pred_mean
5034 t14 = t12+t6*sigsqtc
5036 t21 = thetai-theta0i
5042 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5043 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5044 & *(-t12*t9-ak*sig0inv*t27)
5048 C--------------------------------------------------------------------------
5049 subroutine ebend(etheta)
5051 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5052 C angles gamma and its derivatives in consecutive thetas and gammas.
5053 C ab initio-derived potentials from
5054 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5056 implicit real*8 (a-h,o-z)
5057 include 'DIMENSIONS'
5058 include 'DIMENSIONS.ZSCOPT'
5059 include 'COMMON.LOCAL'
5060 include 'COMMON.GEO'
5061 include 'COMMON.INTERACT'
5062 include 'COMMON.DERIV'
5063 include 'COMMON.VAR'
5064 include 'COMMON.CHAIN'
5065 include 'COMMON.IOUNITS'
5066 include 'COMMON.NAMES'
5067 include 'COMMON.FFIELD'
5068 include 'COMMON.CONTROL'
5069 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5070 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5071 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5072 & sinph1ph2(maxdouble,maxdouble)
5073 logical lprn /.false./, lprn1 /.false./
5075 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
5076 do i=ithet_start,ithet_end
5080 theti2=0.5d0*theta(i)
5081 ityp2=ithetyp(itype(i-1))
5083 coskt(k)=dcos(k*theti2)
5084 sinkt(k)=dsin(k*theti2)
5089 if (phii.ne.phii) phii=150.0
5093 ityp1=ithetyp(itype(i-2))
5095 cosph1(k)=dcos(k*phii)
5096 sinph1(k)=dsin(k*phii)
5109 if (phii1.ne.phii1) phii1=150.0
5114 ityp3=ithetyp(itype(i))
5116 cosph2(k)=dcos(k*phii1)
5117 sinph2(k)=dsin(k*phii1)
5127 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
5128 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
5130 ethetai=aa0thet(ityp1,ityp2,ityp3)
5133 ccl=cosph1(l)*cosph2(k-l)
5134 ssl=sinph1(l)*sinph2(k-l)
5135 scl=sinph1(l)*cosph2(k-l)
5136 csl=cosph1(l)*sinph2(k-l)
5137 cosph1ph2(l,k)=ccl-ssl
5138 cosph1ph2(k,l)=ccl+ssl
5139 sinph1ph2(l,k)=scl+csl
5140 sinph1ph2(k,l)=scl-csl
5144 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5145 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5146 write (iout,*) "coskt and sinkt"
5148 write (iout,*) k,coskt(k),sinkt(k)
5152 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
5153 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
5156 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
5157 & " ethetai",ethetai
5160 write (iout,*) "cosph and sinph"
5162 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5164 write (iout,*) "cosph1ph2 and sinph2ph2"
5167 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5168 & sinph1ph2(l,k),sinph1ph2(k,l)
5171 write(iout,*) "ethetai",ethetai
5175 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
5176 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
5177 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
5178 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
5179 ethetai=ethetai+sinkt(m)*aux
5180 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5181 dephii=dephii+k*sinkt(m)*(
5182 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
5183 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
5184 dephii1=dephii1+k*sinkt(m)*(
5185 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
5186 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
5188 & write (iout,*) "m",m," k",k," bbthet",
5189 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
5190 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
5191 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
5192 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5196 & write(iout,*) "ethetai",ethetai
5200 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5201 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
5202 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5203 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
5204 ethetai=ethetai+sinkt(m)*aux
5205 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5206 dephii=dephii+l*sinkt(m)*(
5207 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
5208 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5209 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
5210 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5211 dephii1=dephii1+(k-l)*sinkt(m)*(
5212 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
5213 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
5214 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
5215 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
5217 write (iout,*) "m",m," k",k," l",l," ffthet",
5218 & ffthet(l,k,m,ityp1,ityp2,ityp3),
5219 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
5220 & ggthet(l,k,m,ityp1,ityp2,ityp3),
5221 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
5222 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5223 & cosph1ph2(k,l)*sinkt(m),
5224 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5230 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5231 & i,theta(i)*rad2deg,phii*rad2deg,
5232 & phii1*rad2deg,ethetai
5233 etheta=etheta+ethetai
5234 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5235 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5236 gloc(nphi+i-2,icg)=wang*dethetai
5242 c-----------------------------------------------------------------------------
5243 subroutine esc(escloc)
5244 C Calculate the local energy of a side chain and its derivatives in the
5245 C corresponding virtual-bond valence angles THETA and the spherical angles
5247 implicit real*8 (a-h,o-z)
5248 include 'DIMENSIONS'
5249 include 'DIMENSIONS.ZSCOPT'
5250 include 'COMMON.GEO'
5251 include 'COMMON.LOCAL'
5252 include 'COMMON.VAR'
5253 include 'COMMON.INTERACT'
5254 include 'COMMON.DERIV'
5255 include 'COMMON.CHAIN'
5256 include 'COMMON.IOUNITS'
5257 include 'COMMON.NAMES'
5258 include 'COMMON.FFIELD'
5259 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5260 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5261 common /sccalc/ time11,time12,time112,theti,it,nlobit
5264 c write (iout,'(a)') 'ESC'
5265 do i=loc_start,loc_end
5267 if (it.eq.10) goto 1
5269 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5270 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5271 theti=theta(i+1)-pipol
5275 c write (iout,*) "i",i," x",x(1),x(2),x(3)
5277 if (x(2).gt.pi-delta) then
5281 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5283 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5284 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5286 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5287 & ddersc0(1),dersc(1))
5288 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5289 & ddersc0(3),dersc(3))
5291 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5293 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5294 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5295 & dersc0(2),esclocbi,dersc02)
5296 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5298 call splinthet(x(2),0.5d0*delta,ss,ssd)
5303 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5305 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5306 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5308 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5310 c write (iout,*) escloci
5311 else if (x(2).lt.delta) then
5315 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5317 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5318 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5320 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5321 & ddersc0(1),dersc(1))
5322 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5323 & ddersc0(3),dersc(3))
5325 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5327 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5328 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5329 & dersc0(2),esclocbi,dersc02)
5330 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5335 call splinthet(x(2),0.5d0*delta,ss,ssd)
5337 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5339 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5340 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5342 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5343 c write (iout,*) escloci
5345 call enesc(x,escloci,dersc,ddummy,.false.)
5348 escloc=escloc+escloci
5349 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5351 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5353 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5354 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5359 C---------------------------------------------------------------------------
5360 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5361 implicit real*8 (a-h,o-z)
5362 include 'DIMENSIONS'
5363 include 'DIMENSIONS.ZSCOPT'
5364 include 'COMMON.GEO'
5365 include 'COMMON.LOCAL'
5366 include 'COMMON.IOUNITS'
5367 common /sccalc/ time11,time12,time112,theti,it,nlobit
5368 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5369 double precision contr(maxlob,-1:1)
5371 c write (iout,*) 'it=',it,' nlobit=',nlobit
5375 if (mixed) ddersc(j)=0.0d0
5379 C Because of periodicity of the dependence of the SC energy in omega we have
5380 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5381 C To avoid underflows, first compute & store the exponents.
5389 z(k)=x(k)-censc(k,j,it)
5394 Axk=Axk+gaussc(l,k,j,it)*z(l)
5400 expfac=expfac+Ax(k,j,iii)*z(k)
5408 C As in the case of ebend, we want to avoid underflows in exponentiation and
5409 C subsequent NaNs and INFs in energy calculation.
5410 C Find the largest exponent
5414 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5418 cd print *,'it=',it,' emin=',emin
5420 C Compute the contribution to SC energy and derivatives
5424 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5425 cd print *,'j=',j,' expfac=',expfac
5426 escloc_i=escloc_i+expfac
5428 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5432 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5433 & +gaussc(k,2,j,it))*expfac
5440 dersc(1)=dersc(1)/cos(theti)**2
5441 ddersc(1)=ddersc(1)/cos(theti)**2
5444 escloci=-(dlog(escloc_i)-emin)
5446 dersc(j)=dersc(j)/escloc_i
5450 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5455 C------------------------------------------------------------------------------
5456 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5457 implicit real*8 (a-h,o-z)
5458 include 'DIMENSIONS'
5459 include 'DIMENSIONS.ZSCOPT'
5460 include 'COMMON.GEO'
5461 include 'COMMON.LOCAL'
5462 include 'COMMON.IOUNITS'
5463 common /sccalc/ time11,time12,time112,theti,it,nlobit
5464 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5465 double precision contr(maxlob)
5476 z(k)=x(k)-censc(k,j,it)
5482 Axk=Axk+gaussc(l,k,j,it)*z(l)
5488 expfac=expfac+Ax(k,j)*z(k)
5493 C As in the case of ebend, we want to avoid underflows in exponentiation and
5494 C subsequent NaNs and INFs in energy calculation.
5495 C Find the largest exponent
5498 if (emin.gt.contr(j)) emin=contr(j)
5502 C Compute the contribution to SC energy and derivatives
5506 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5507 escloc_i=escloc_i+expfac
5509 dersc(k)=dersc(k)+Ax(k,j)*expfac
5511 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5512 & +gaussc(1,2,j,it))*expfac
5516 dersc(1)=dersc(1)/cos(theti)**2
5517 dersc12=dersc12/cos(theti)**2
5518 escloci=-(dlog(escloc_i)-emin)
5520 dersc(j)=dersc(j)/escloc_i
5522 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5526 c----------------------------------------------------------------------------------
5527 subroutine esc(escloc)
5528 C Calculate the local energy of a side chain and its derivatives in the
5529 C corresponding virtual-bond valence angles THETA and the spherical angles
5530 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5531 C added by Urszula Kozlowska. 07/11/2007
5533 implicit real*8 (a-h,o-z)
5534 include 'DIMENSIONS'
5535 include 'DIMENSIONS.ZSCOPT'
5536 include 'COMMON.GEO'
5537 include 'COMMON.LOCAL'
5538 include 'COMMON.VAR'
5539 include 'COMMON.SCROT'
5540 include 'COMMON.INTERACT'
5541 include 'COMMON.DERIV'
5542 include 'COMMON.CHAIN'
5543 include 'COMMON.IOUNITS'
5544 include 'COMMON.NAMES'
5545 include 'COMMON.FFIELD'
5546 include 'COMMON.CONTROL'
5547 include 'COMMON.VECTORS'
5548 double precision x_prime(3),y_prime(3),z_prime(3)
5549 & , sumene,dsc_i,dp2_i,x(65),
5550 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5551 & de_dxx,de_dyy,de_dzz,de_dt
5552 double precision s1_t,s1_6_t,s2_t,s2_6_t
5554 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5555 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5556 & dt_dCi(3),dt_dCi1(3)
5557 common /sccalc/ time11,time12,time112,theti,it,nlobit
5560 do i=loc_start,loc_end
5561 costtab(i+1) =dcos(theta(i+1))
5562 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5563 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5564 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5565 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5566 cosfac=dsqrt(cosfac2)
5567 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5568 sinfac=dsqrt(sinfac2)
5570 if (it.eq.10) goto 1
5572 C Compute the axes of tghe local cartesian coordinates system; store in
5573 c x_prime, y_prime and z_prime
5580 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5581 C & dc_norm(3,i+nres)
5583 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5584 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5587 z_prime(j) = -uz(j,i-1)
5590 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5591 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5592 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5593 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5594 c & " xy",scalar(x_prime(1),y_prime(1)),
5595 c & " xz",scalar(x_prime(1),z_prime(1)),
5596 c & " yy",scalar(y_prime(1),y_prime(1)),
5597 c & " yz",scalar(y_prime(1),z_prime(1)),
5598 c & " zz",scalar(z_prime(1),z_prime(1))
5600 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5601 C to local coordinate system. Store in xx, yy, zz.
5607 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5608 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5609 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5616 C Compute the energy of the ith side cbain
5618 c write (2,*) "xx",xx," yy",yy," zz",zz
5621 x(j) = sc_parmin(j,it)
5624 Cc diagnostics - remove later
5626 yy1 = dsin(alph(2))*dcos(omeg(2))
5627 zz1 = -dsin(alph(2))*dsin(omeg(2))
5628 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5629 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5631 C," --- ", xx_w,yy_w,zz_w
5634 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5635 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5637 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5638 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5640 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5641 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5642 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5643 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5644 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5646 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5647 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5648 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5649 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5650 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5652 dsc_i = 0.743d0+x(61)
5654 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5655 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5656 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5657 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5658 s1=(1+x(63))/(0.1d0 + dscp1)
5659 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5660 s2=(1+x(65))/(0.1d0 + dscp2)
5661 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5662 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5663 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5664 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5666 c & dscp1,dscp2,sumene
5667 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5668 escloc = escloc + sumene
5669 c write (2,*) "escloc",escloc
5670 if (.not. calc_grad) goto 1
5673 C This section to check the numerical derivatives of the energy of ith side
5674 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5675 C #define DEBUG in the code to turn it on.
5677 write (2,*) "sumene =",sumene
5681 write (2,*) xx,yy,zz
5682 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5683 de_dxx_num=(sumenep-sumene)/aincr
5685 write (2,*) "xx+ sumene from enesc=",sumenep
5688 write (2,*) xx,yy,zz
5689 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5690 de_dyy_num=(sumenep-sumene)/aincr
5692 write (2,*) "yy+ sumene from enesc=",sumenep
5695 write (2,*) xx,yy,zz
5696 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5697 de_dzz_num=(sumenep-sumene)/aincr
5699 write (2,*) "zz+ sumene from enesc=",sumenep
5700 costsave=cost2tab(i+1)
5701 sintsave=sint2tab(i+1)
5702 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5703 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5704 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5705 de_dt_num=(sumenep-sumene)/aincr
5706 write (2,*) " t+ sumene from enesc=",sumenep
5707 cost2tab(i+1)=costsave
5708 sint2tab(i+1)=sintsave
5709 C End of diagnostics section.
5712 C Compute the gradient of esc
5714 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5715 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5716 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5717 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5718 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5719 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5720 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5721 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5722 pom1=(sumene3*sint2tab(i+1)+sumene1)
5723 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5724 pom2=(sumene4*cost2tab(i+1)+sumene2)
5725 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5726 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5727 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5728 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5730 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5731 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5732 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5734 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5735 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5736 & +(pom1+pom2)*pom_dx
5738 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5741 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5742 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5743 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5745 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5746 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5747 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5748 & +x(59)*zz**2 +x(60)*xx*zz
5749 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5750 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5751 & +(pom1-pom2)*pom_dy
5753 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5756 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5757 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5758 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5759 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5760 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5761 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5762 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5763 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5765 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5768 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5769 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5770 & +pom1*pom_dt1+pom2*pom_dt2
5772 write(2,*), "de_dt = ", de_dt,de_dt_num
5776 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5777 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5778 cosfac2xx=cosfac2*xx
5779 sinfac2yy=sinfac2*yy
5781 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5783 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5785 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5786 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5787 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5788 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5789 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5790 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5791 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5792 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5793 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5794 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5798 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5799 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5802 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5803 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5804 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5806 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5807 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5811 dXX_Ctab(k,i)=dXX_Ci(k)
5812 dXX_C1tab(k,i)=dXX_Ci1(k)
5813 dYY_Ctab(k,i)=dYY_Ci(k)
5814 dYY_C1tab(k,i)=dYY_Ci1(k)
5815 dZZ_Ctab(k,i)=dZZ_Ci(k)
5816 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5817 dXX_XYZtab(k,i)=dXX_XYZ(k)
5818 dYY_XYZtab(k,i)=dYY_XYZ(k)
5819 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5823 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5824 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5825 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5826 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5827 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5829 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5830 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5831 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5832 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5833 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5834 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5835 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5836 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5838 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5839 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5841 C to check gradient call subroutine check_grad
5848 c------------------------------------------------------------------------------
5849 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5851 C This procedure calculates two-body contact function g(rij) and its derivative:
5854 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5857 C where x=(rij-r0ij)/delta
5859 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5862 double precision rij,r0ij,eps0ij,fcont,fprimcont
5863 double precision x,x2,x4,delta
5867 if (x.lt.-1.0D0) then
5870 else if (x.le.1.0D0) then
5873 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5874 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5881 c------------------------------------------------------------------------------
5882 subroutine splinthet(theti,delta,ss,ssder)
5883 implicit real*8 (a-h,o-z)
5884 include 'DIMENSIONS'
5885 include 'DIMENSIONS.ZSCOPT'
5886 include 'COMMON.VAR'
5887 include 'COMMON.GEO'
5890 if (theti.gt.pipol) then
5891 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5893 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5898 c------------------------------------------------------------------------------
5899 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5901 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5902 double precision ksi,ksi2,ksi3,a1,a2,a3
5903 a1=fprim0*delta/(f1-f0)
5909 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5910 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5913 c------------------------------------------------------------------------------
5914 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5916 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5917 double precision ksi,ksi2,ksi3,a1,a2,a3
5922 a2=3*(f1x-f0x)-2*fprim0x*delta
5923 a3=fprim0x*delta-2*(f1x-f0x)
5924 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5927 C-----------------------------------------------------------------------------
5929 C-----------------------------------------------------------------------------
5930 subroutine etor(etors,edihcnstr)
5931 implicit real*8 (a-h,o-z)
5932 include 'DIMENSIONS'
5933 include 'DIMENSIONS.ZSCOPT'
5934 include 'COMMON.VAR'
5935 include 'COMMON.GEO'
5936 include 'COMMON.LOCAL'
5937 include 'COMMON.TORSION'
5938 include 'COMMON.INTERACT'
5939 include 'COMMON.DERIV'
5940 include 'COMMON.CHAIN'
5941 include 'COMMON.NAMES'
5942 include 'COMMON.IOUNITS'
5943 include 'COMMON.FFIELD'
5944 include 'COMMON.TORCNSTR'
5946 C Set lprn=.true. for debugging
5950 do i=iphi_start,iphi_end
5951 itori=itortyp(itype(i-2))
5952 itori1=itortyp(itype(i-1))
5955 C Proline-Proline pair is a special case...
5956 if (itori.eq.3 .and. itori1.eq.3) then
5957 if (phii.gt.-dwapi3) then
5959 fac=1.0D0/(1.0D0-cosphi)
5960 etorsi=v1(1,3,3)*fac
5961 etorsi=etorsi+etorsi
5962 etors=etors+etorsi-v1(1,3,3)
5963 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5966 v1ij=v1(j+1,itori,itori1)
5967 v2ij=v2(j+1,itori,itori1)
5970 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5971 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5975 v1ij=v1(j,itori,itori1)
5976 v2ij=v2(j,itori,itori1)
5979 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5980 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5984 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5985 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5986 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5987 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5988 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5990 ! 6/20/98 - dihedral angle constraints
5993 itori=idih_constr(i)
5996 if (difi.gt.drange(i)) then
5998 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5999 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6000 else if (difi.lt.-drange(i)) then
6002 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6003 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6005 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6006 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6008 ! write (iout,*) 'edihcnstr',edihcnstr
6011 c------------------------------------------------------------------------------
6013 subroutine etor(etors,edihcnstr)
6014 implicit real*8 (a-h,o-z)
6015 include 'DIMENSIONS'
6016 include 'DIMENSIONS.ZSCOPT'
6017 include 'COMMON.VAR'
6018 include 'COMMON.GEO'
6019 include 'COMMON.LOCAL'
6020 include 'COMMON.TORSION'
6021 include 'COMMON.INTERACT'
6022 include 'COMMON.DERIV'
6023 include 'COMMON.CHAIN'
6024 include 'COMMON.NAMES'
6025 include 'COMMON.IOUNITS'
6026 include 'COMMON.FFIELD'
6027 include 'COMMON.TORCNSTR'
6028 include 'COMMON.WEIGHTS'
6029 include 'COMMON.WEIGHTDER'
6031 integer itor2typ(3) /10,9,20/
6032 C Set lprn=.true. for debugging
6040 etor_temp(l,k,j,i)=0.0d0
6045 do i=iphi_start,iphi_end
6046 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
6047 itori=itortyp(itype(i-2))
6048 itori1=itortyp(itype(i-1))
6049 weitori=weitor(0,itori,itori1)
6053 C Regular cosine and sine terms
6054 do j=1,nterm(itori,itori1)
6055 v1ij=v1(j,itori,itori1)
6056 v2ij=v2(j,itori,itori1)
6059 etori=etori+v1ij*cosphi+v2ij*sinphi
6060 etor_temp(j,0,itori,itori1)=etor_temp(j,0,itori,itori1)+
6062 etor_temp(nterm(itori,itori1)+j,0,itori,itori1)=
6063 & etor_temp(nterm(itori,itori1)+j,0,itori,itori1)+
6065 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6069 C E = SUM ----------------------------------- - v1
6070 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6072 cosphi=dcos(0.5d0*phii)
6073 sinphi=dsin(0.5d0*phii)
6074 do j=1,nlor(itori,itori1)
6075 vl1ij=vlor1(j,itori,itori1)
6076 vl2ij=vlor2(j,itori,itori1)
6077 vl3ij=vlor3(j,itori,itori1)
6078 pom=vl2ij*cosphi+vl3ij*sinphi
6079 pom1=1.0d0/(pom*pom+1.0d0)
6080 etori=etori+vl1ij*pom1
6082 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6084 C Subtract the constant term
6085 etors=etors+(etori-v0(itori,itori1))*weitori
6086 etor_temp(0,0,itori,itori1)=etor_temp(0,0,itori,itori1)+
6087 & (etori-v0(itori,itori1))*ww(13)
6090 write (iout,'(2(a3,2x,i3,2x),2i3,8f8.3/26x,6f8.3/)')
6091 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6092 & weitori,v0(itori,itori1)*weitori,(v1(j,itori,itori1)*weitori,
6093 & j=1,6),(v2(j,itori,itori1)*weitori,j=1,6)
6094 write (iout,*) "typ",itori,itor2typ(itori),itori1,
6095 & itor2typ(itori1)," etor_temp",
6096 & etor_temp(0,0,itori,itori1)
6099 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6100 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6103 ! 6/20/98 - dihedral angle constraints
6107 itori=idih_constr(i)
6110 if (difi.gt.drange(i)) then
6112 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6113 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6114 else if (difi.lt.-drange(i)) then
6116 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6117 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6119 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6120 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6122 ! write (iout,*) 'edihcnstr',edihcnstr
6125 c----------------------------------------------------------------------------
6126 subroutine etor_d(etors_d)
6127 C 6/23/01 Compute double torsional energy
6128 implicit real*8 (a-h,o-z)
6129 include 'DIMENSIONS'
6130 include 'DIMENSIONS.ZSCOPT'
6131 include 'COMMON.VAR'
6132 include 'COMMON.GEO'
6133 include 'COMMON.LOCAL'
6134 include 'COMMON.TORSION'
6135 include 'COMMON.INTERACT'
6136 include 'COMMON.DERIV'
6137 include 'COMMON.CHAIN'
6138 include 'COMMON.NAMES'
6139 include 'COMMON.IOUNITS'
6140 include 'COMMON.FFIELD'
6141 include 'COMMON.TORCNSTR'
6143 C Set lprn=.true. for debugging
6147 do i=iphi_start,iphi_end-1
6148 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
6150 itori=itortyp(itype(i-2))
6151 itori1=itortyp(itype(i-1))
6152 itori2=itortyp(itype(i))
6157 C Regular cosine and sine terms
6158 do j=1,ntermd_1(itori,itori1,itori2)
6159 v1cij=v1c(1,j,itori,itori1,itori2)
6160 v1sij=v1s(1,j,itori,itori1,itori2)
6161 v2cij=v1c(2,j,itori,itori1,itori2)
6162 v2sij=v1s(2,j,itori,itori1,itori2)
6163 cosphi1=dcos(j*phii)
6164 sinphi1=dsin(j*phii)
6165 cosphi2=dcos(j*phii1)
6166 sinphi2=dsin(j*phii1)
6167 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6168 & v2cij*cosphi2+v2sij*sinphi2
6169 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6170 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6172 do k=2,ntermd_2(itori,itori1,itori2)
6174 v1cdij = v2c(k,l,itori,itori1,itori2)
6175 v2cdij = v2c(l,k,itori,itori1,itori2)
6176 v1sdij = v2s(k,l,itori,itori1,itori2)
6177 v2sdij = v2s(l,k,itori,itori1,itori2)
6178 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6179 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6180 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6181 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6182 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6183 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6184 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6185 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6186 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6187 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6190 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6191 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6197 c------------------------------------------------------------------------------
6198 subroutine eback_sc_corr(esccor)
6199 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6200 c conformational states; temporarily implemented as differences
6201 c between UNRES torsional potentials (dependent on three types of
6202 c residues) and the torsional potentials dependent on all 20 types
6203 c of residues computed from AM1 energy surfaces of terminally-blocked
6204 c amino-acid residues.
6205 implicit real*8 (a-h,o-z)
6206 include 'DIMENSIONS'
6207 include 'DIMENSIONS.ZSCOPT'
6208 include 'COMMON.VAR'
6209 include 'COMMON.GEO'
6210 include 'COMMON.LOCAL'
6211 include 'COMMON.TORSION'
6212 include 'COMMON.SCCOR'
6213 include 'COMMON.INTERACT'
6214 include 'COMMON.DERIV'
6215 include 'COMMON.CHAIN'
6216 include 'COMMON.NAMES'
6217 include 'COMMON.IOUNITS'
6218 include 'COMMON.FFIELD'
6219 include 'COMMON.CONTROL'
6220 include 'COMMON.WEIGHTS'
6221 include 'COMMON.WEIGHTDER'
6223 C Set lprn=.true. for debugging
6226 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
6228 do i=itau_start,itau_end
6229 c write (iout,*) "i",i," itype",itype(i-2),itype(i-1)
6232 isccori=isccortyp(itype(i-2))
6233 isccori1=isccortyp(itype(i-1))
6235 c write (iout,*) "i",i," isccori",isccori," isccori1",isccori1,
6238 cccc Added 9 May 2012
6239 cc Tauangle is torsional engle depending on the value of first digit
6240 c(see comment below)
6241 cc Omicron is flat angle depending on the value of first digit
6242 c(see comment below)
6244 do intertyp=1,3 !intertyp
6245 cc Added 09 May 2012 (Adasko)
6246 cc Intertyp means interaction type of backbone mainchain correlation:
6247 c 1 = SC...Ca...Ca...Ca
6248 c 2 = Ca...Ca...Ca...SC
6249 c 3 = SC...Ca...Ca...SCi
6251 weitori=weitor(intertyp,isccori,isccori1)
6252 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6253 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
6254 & (itype(i-1).eq.21)))
6255 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6256 & .or.(itype(i-2).eq.21)))
6257 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6258 & (itype(i-1).eq.21)))) cycle
6259 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
6260 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
6263 do j=1,nterm_sccor(isccori,isccori1)
6264 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6265 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6266 cosphi=dcos(j*tauangle(intertyp,i))
6267 sinphi=dsin(j*tauangle(intertyp,i))
6268 esccori=esccori+v1ij*cosphi+v2ij*sinphi
6269 etor_temp(j,intertyp,isccori,isccori1)=
6270 & etor_temp(j,intertyp,isccori,isccori1)+cosphi*ww(19)
6271 etor_temp(nterm_sccor(isccori,isccori1)+j,intertyp,
6272 & isccori,isccori1)=etor_temp(nterm_sccor(isccori,isccori1)+j,
6273 & intertyp,isccori,isccori1)+sinphi*ww(19)
6274 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6276 esccor=esccor+weitori*esccori
6277 etor_temp(0,intertyp,isccori,isccori1)=
6278 & etor_temp(0,intertyp,isccori,isccori1)+esccori*ww(19)
6279 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6280 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
6281 c &gloc_sc(intertyp,i-3,icg)
6283 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6284 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6285 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6286 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6287 write (iout,*) "esccori",esccori
6290 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6295 c------------------------------------------------------------------------------
6296 subroutine multibody(ecorr)
6297 C This subroutine calculates multi-body contributions to energy following
6298 C the idea of Skolnick et al. If side chains I and J make a contact and
6299 C at the same time side chains I+1 and J+1 make a contact, an extra
6300 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6301 implicit real*8 (a-h,o-z)
6302 include 'DIMENSIONS'
6303 include 'DIMENSIONS.ZSCOPT'
6304 include 'COMMON.IOUNITS'
6305 include 'COMMON.DERIV'
6306 include 'COMMON.INTERACT'
6307 include 'COMMON.CONTACTS'
6308 double precision gx(3),gx1(3)
6311 C Set lprn=.true. for debugging
6315 write (iout,'(a)') 'Contact function values:'
6317 write (iout,'(i2,20(1x,i2,f10.5))')
6318 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6333 num_conti=num_cont(i)
6334 num_conti1=num_cont(i1)
6339 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6340 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6341 cd & ' ishift=',ishift
6342 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6343 C The system gains extra energy.
6344 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6345 endif ! j1==j+-ishift
6354 c------------------------------------------------------------------------------
6355 double precision function esccorr(i,j,k,l,jj,kk)
6356 implicit real*8 (a-h,o-z)
6357 include 'DIMENSIONS'
6358 include 'DIMENSIONS.ZSCOPT'
6359 include 'COMMON.IOUNITS'
6360 include 'COMMON.DERIV'
6361 include 'COMMON.INTERACT'
6362 include 'COMMON.CONTACTS'
6363 double precision gx(3),gx1(3)
6368 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6369 C Calculate the multi-body contribution to energy.
6370 C Calculate multi-body contributions to the gradient.
6371 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6372 cd & k,l,(gacont(m,kk,k),m=1,3)
6374 gx(m) =ekl*gacont(m,jj,i)
6375 gx1(m)=eij*gacont(m,kk,k)
6376 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6377 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6378 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6379 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6383 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6388 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6394 c------------------------------------------------------------------------------
6396 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
6397 implicit real*8 (a-h,o-z)
6398 include 'DIMENSIONS'
6399 integer dimen1,dimen2,atom,indx
6400 double precision buffer(dimen1,dimen2)
6401 double precision zapas
6402 common /contacts_hb/ zapas(3,20,maxres,7),
6403 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6404 & num_cont_hb(maxres),jcont_hb(20,maxres)
6405 num_kont=num_cont_hb(atom)
6409 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
6412 buffer(i,indx+22)=facont_hb(i,atom)
6413 buffer(i,indx+23)=ees0p(i,atom)
6414 buffer(i,indx+24)=ees0m(i,atom)
6415 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
6417 buffer(1,indx+26)=dfloat(num_kont)
6420 c------------------------------------------------------------------------------
6421 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
6422 implicit real*8 (a-h,o-z)
6423 include 'DIMENSIONS'
6424 integer dimen1,dimen2,atom,indx
6425 double precision buffer(dimen1,dimen2)
6426 double precision zapas
6427 common /contacts_hb/ zapas(3,20,maxres,7),
6428 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
6429 & num_cont_hb(maxres),jcont_hb(20,maxres)
6430 num_kont=buffer(1,indx+26)
6431 num_kont_old=num_cont_hb(atom)
6432 num_cont_hb(atom)=num_kont+num_kont_old
6437 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
6440 facont_hb(ii,atom)=buffer(i,indx+22)
6441 ees0p(ii,atom)=buffer(i,indx+23)
6442 ees0m(ii,atom)=buffer(i,indx+24)
6443 jcont_hb(ii,atom)=buffer(i,indx+25)
6447 c------------------------------------------------------------------------------
6449 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6450 C This subroutine calculates multi-body contributions to hydrogen-bonding
6451 implicit real*8 (a-h,o-z)
6452 include 'DIMENSIONS'
6453 include 'DIMENSIONS.ZSCOPT'
6454 include 'COMMON.IOUNITS'
6456 include 'COMMON.INFO'
6458 include 'COMMON.FFIELD'
6459 include 'COMMON.DERIV'
6460 include 'COMMON.INTERACT'
6461 include 'COMMON.CONTACTS'
6463 parameter (max_cont=maxconts)
6464 parameter (max_dim=2*(8*3+2))
6465 parameter (msglen1=max_cont*max_dim*4)
6466 parameter (msglen2=2*msglen1)
6467 integer source,CorrelType,CorrelID,Error
6468 double precision buffer(max_cont,max_dim)
6470 double precision gx(3),gx1(3)
6473 C Set lprn=.true. for debugging
6478 if (fgProcs.le.1) goto 30
6480 write (iout,'(a)') 'Contact function values:'
6482 write (iout,'(2i3,50(1x,i2,f5.2))')
6483 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6484 & j=1,num_cont_hb(i))
6487 C Caution! Following code assumes that electrostatic interactions concerning
6488 C a given atom are split among at most two processors!
6498 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6501 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6502 if (MyRank.gt.0) then
6503 C Send correlation contributions to the preceding processor
6505 nn=num_cont_hb(iatel_s)
6506 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6507 cd write (iout,*) 'The BUFFER array:'
6509 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6511 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6513 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6514 C Clear the contacts of the atom passed to the neighboring processor
6515 nn=num_cont_hb(iatel_s+1)
6517 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6519 num_cont_hb(iatel_s)=0
6521 cd write (iout,*) 'Processor ',MyID,MyRank,
6522 cd & ' is sending correlation contribution to processor',MyID-1,
6523 cd & ' msglen=',msglen
6524 cd write (*,*) 'Processor ',MyID,MyRank,
6525 cd & ' is sending correlation contribution to processor',MyID-1,
6526 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6527 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6528 cd write (iout,*) 'Processor ',MyID,
6529 cd & ' has sent correlation contribution to processor',MyID-1,
6530 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6531 cd write (*,*) 'Processor ',MyID,
6532 cd & ' has sent correlation contribution to processor',MyID-1,
6533 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6535 endif ! (MyRank.gt.0)
6539 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6540 if (MyRank.lt.fgProcs-1) then
6541 C Receive correlation contributions from the next processor
6543 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6544 cd write (iout,*) 'Processor',MyID,
6545 cd & ' is receiving correlation contribution from processor',MyID+1,
6546 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6547 cd write (*,*) 'Processor',MyID,
6548 cd & ' is receiving correlation contribution from processor',MyID+1,
6549 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6551 do while (nbytes.le.0)
6552 call mp_probe(MyID+1,CorrelType,nbytes)
6554 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6555 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6556 cd write (iout,*) 'Processor',MyID,
6557 cd & ' has received correlation contribution from processor',MyID+1,
6558 cd & ' msglen=',msglen,' nbytes=',nbytes
6559 cd write (iout,*) 'The received BUFFER array:'
6561 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6563 if (msglen.eq.msglen1) then
6564 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6565 else if (msglen.eq.msglen2) then
6566 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6567 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6570 & 'ERROR!!!! message length changed while processing correlations.'
6572 & 'ERROR!!!! message length changed while processing correlations.'
6573 call mp_stopall(Error)
6574 endif ! msglen.eq.msglen1
6575 endif ! MyRank.lt.fgProcs-1
6582 write (iout,'(a)') 'Contact function values:'
6584 write (iout,'(2i3,50(1x,i2,f5.2))')
6585 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6586 & j=1,num_cont_hb(i))
6590 C Remove the loop below after debugging !!!
6597 C Calculate the local-electrostatic correlation terms
6598 do i=iatel_s,iatel_e+1
6600 num_conti=num_cont_hb(i)
6601 num_conti1=num_cont_hb(i+1)
6606 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6607 c & ' jj=',jj,' kk=',kk
6608 if (j1.eq.j+1 .or. j1.eq.j-1) then
6609 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6610 C The system gains extra energy.
6611 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6613 else if (j1.eq.j) then
6614 C Contacts I-J and I-(J+1) occur simultaneously.
6615 C The system loses extra energy.
6616 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6621 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6622 c & ' jj=',jj,' kk=',kk
6624 C Contacts I-J and (I+1)-J occur simultaneously.
6625 C The system loses extra energy.
6626 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6633 c------------------------------------------------------------------------------
6634 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6636 C This subroutine calculates multi-body contributions to hydrogen-bonding
6637 implicit real*8 (a-h,o-z)
6638 include 'DIMENSIONS'
6639 include 'DIMENSIONS.ZSCOPT'
6640 include 'COMMON.IOUNITS'
6642 include 'COMMON.INFO'
6644 include 'COMMON.FFIELD'
6645 include 'COMMON.DERIV'
6646 include 'COMMON.INTERACT'
6647 include 'COMMON.CONTACTS'
6649 parameter (max_cont=maxconts)
6650 parameter (max_dim=2*(8*3+2))
6651 parameter (msglen1=max_cont*max_dim*4)
6652 parameter (msglen2=2*msglen1)
6653 integer source,CorrelType,CorrelID,Error
6654 double precision buffer(max_cont,max_dim)
6656 double precision gx(3),gx1(3)
6659 C Set lprn=.true. for debugging
6665 if (fgProcs.le.1) goto 30
6667 write (iout,'(a)') 'Contact function values:'
6669 write (iout,'(2i3,50(1x,i2,f5.2))')
6670 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6671 & j=1,num_cont_hb(i))
6674 C Caution! Following code assumes that electrostatic interactions concerning
6675 C a given atom are split among at most two processors!
6685 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6688 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6689 if (MyRank.gt.0) then
6690 C Send correlation contributions to the preceding processor
6692 nn=num_cont_hb(iatel_s)
6693 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6694 cd write (iout,*) 'The BUFFER array:'
6696 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6698 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6700 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6701 C Clear the contacts of the atom passed to the neighboring processor
6702 nn=num_cont_hb(iatel_s+1)
6704 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6706 num_cont_hb(iatel_s)=0
6708 cd write (iout,*) 'Processor ',MyID,MyRank,
6709 cd & ' is sending correlation contribution to processor',MyID-1,
6710 cd & ' msglen=',msglen
6711 cd write (*,*) 'Processor ',MyID,MyRank,
6712 cd & ' is sending correlation contribution to processor',MyID-1,
6713 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6714 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6715 cd write (iout,*) 'Processor ',MyID,
6716 cd & ' has sent correlation contribution to processor',MyID-1,
6717 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6718 cd write (*,*) 'Processor ',MyID,
6719 cd & ' has sent correlation contribution to processor',MyID-1,
6720 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6722 endif ! (MyRank.gt.0)
6726 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6727 if (MyRank.lt.fgProcs-1) then
6728 C Receive correlation contributions from the next processor
6730 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6731 cd write (iout,*) 'Processor',MyID,
6732 cd & ' is receiving correlation contribution from processor',MyID+1,
6733 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6734 cd write (*,*) 'Processor',MyID,
6735 cd & ' is receiving correlation contribution from processor',MyID+1,
6736 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6738 do while (nbytes.le.0)
6739 call mp_probe(MyID+1,CorrelType,nbytes)
6741 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6742 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6743 cd write (iout,*) 'Processor',MyID,
6744 cd & ' has received correlation contribution from processor',MyID+1,
6745 cd & ' msglen=',msglen,' nbytes=',nbytes
6746 cd write (iout,*) 'The received BUFFER array:'
6748 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6750 if (msglen.eq.msglen1) then
6751 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6752 else if (msglen.eq.msglen2) then
6753 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6754 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6757 & 'ERROR!!!! message length changed while processing correlations.'
6759 & 'ERROR!!!! message length changed while processing correlations.'
6760 call mp_stopall(Error)
6761 endif ! msglen.eq.msglen1
6762 endif ! MyRank.lt.fgProcs-1
6769 write (iout,'(a)') 'Contact function values:'
6771 write (iout,'(2i3,50(1x,i2,f5.2))')
6772 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6773 & j=1,num_cont_hb(i))
6779 C Remove the loop below after debugging !!!
6786 C Calculate the dipole-dipole interaction energies
6787 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6788 do i=iatel_s,iatel_e+1
6789 num_conti=num_cont_hb(i)
6796 C Calculate the local-electrostatic correlation terms
6797 do i=iatel_s,iatel_e+1
6799 num_conti=num_cont_hb(i)
6800 num_conti1=num_cont_hb(i+1)
6805 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6806 c & ' jj=',jj,' kk=',kk
6807 if (j1.eq.j+1 .or. j1.eq.j-1) then
6808 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6809 C The system gains extra energy.
6811 sqd1=dsqrt(d_cont(jj,i))
6812 sqd2=dsqrt(d_cont(kk,i1))
6813 sred_geom = sqd1*sqd2
6814 IF (sred_geom.lt.cutoff_corr) THEN
6815 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6817 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6818 c & ' jj=',jj,' kk=',kk
6819 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6820 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6822 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6823 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6826 cd write (iout,*) 'sred_geom=',sred_geom,
6827 cd & ' ekont=',ekont,' fprim=',fprimcont
6828 call calc_eello(i,j,i+1,j1,jj,kk)
6829 if (wcorr4.gt.0.0d0)
6830 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6831 if (wcorr5.gt.0.0d0)
6832 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6833 c print *,"wcorr5",ecorr5
6834 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6835 cd write(2,*)'ijkl',i,j,i+1,j1
6836 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6837 & .or. wturn6.eq.0.0d0))then
6838 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6839 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6840 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6841 cd & 'ecorr6=',ecorr6
6842 cd write (iout,'(4e15.5)') sred_geom,
6843 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6844 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6845 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6846 else if (wturn6.gt.0.0d0
6847 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6848 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6849 eturn6=eturn6+eello_turn6(i,jj,kk)
6850 cd write (2,*) 'multibody_eello:eturn6',eturn6
6854 else if (j1.eq.j) then
6855 C Contacts I-J and I-(J+1) occur simultaneously.
6856 C The system loses extra energy.
6857 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6862 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6863 c & ' jj=',jj,' kk=',kk
6865 C Contacts I-J and (I+1)-J occur simultaneously.
6866 C The system loses extra energy.
6867 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6874 c------------------------------------------------------------------------------
6875 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6876 implicit real*8 (a-h,o-z)
6877 include 'DIMENSIONS'
6878 include 'DIMENSIONS.ZSCOPT'
6879 include 'COMMON.IOUNITS'
6880 include 'COMMON.DERIV'
6881 include 'COMMON.INTERACT'
6882 include 'COMMON.CONTACTS'
6883 double precision gx(3),gx1(3)
6893 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6894 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6895 C Following 4 lines for diagnostics.
6900 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6902 c write (iout,*)'Contacts have occurred for peptide groups',
6903 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6904 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6905 C Calculate the multi-body contribution to energy.
6906 ecorr=ecorr+ekont*ees
6908 C Calculate multi-body contributions to the gradient.
6910 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6911 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6912 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6913 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6914 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6915 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6916 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6917 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6918 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6919 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6920 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6921 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6922 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6923 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6927 gradcorr(ll,m)=gradcorr(ll,m)+
6928 & ees*ekl*gacont_hbr(ll,jj,i)-
6929 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6930 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6935 gradcorr(ll,m)=gradcorr(ll,m)+
6936 & ees*eij*gacont_hbr(ll,kk,k)-
6937 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6938 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6945 C---------------------------------------------------------------------------
6946 subroutine dipole(i,j,jj)
6947 implicit real*8 (a-h,o-z)
6948 include 'DIMENSIONS'
6949 include 'DIMENSIONS.ZSCOPT'
6950 include 'COMMON.IOUNITS'
6951 include 'COMMON.CHAIN'
6952 include 'COMMON.FFIELD'
6953 include 'COMMON.DERIV'
6954 include 'COMMON.INTERACT'
6955 include 'COMMON.CONTACTS'
6956 include 'COMMON.TORSION'
6957 include 'COMMON.VAR'
6958 include 'COMMON.GEO'
6959 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6961 iti1 = itortyp(itype(i+1))
6962 if (j.lt.nres-1) then
6963 itj1 = itortyp(itype(j+1))
6968 dipi(iii,1)=Ub2(iii,i)
6969 dipderi(iii)=Ub2der(iii,i)
6970 dipi(iii,2)=b1(iii,iti1)
6971 dipj(iii,1)=Ub2(iii,j)
6972 dipderj(iii)=Ub2der(iii,j)
6973 dipj(iii,2)=b1(iii,itj1)
6977 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6980 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6983 if (.not.calc_grad) return
6988 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6992 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6997 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6998 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7000 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7002 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7004 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7008 C---------------------------------------------------------------------------
7009 subroutine calc_eello(i,j,k,l,jj,kk)
7011 C This subroutine computes matrices and vectors needed to calculate
7012 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7014 implicit real*8 (a-h,o-z)
7015 include 'DIMENSIONS'
7016 include 'DIMENSIONS.ZSCOPT'
7017 include 'COMMON.IOUNITS'
7018 include 'COMMON.CHAIN'
7019 include 'COMMON.DERIV'
7020 include 'COMMON.INTERACT'
7021 include 'COMMON.CONTACTS'
7022 include 'COMMON.TORSION'
7023 include 'COMMON.VAR'
7024 include 'COMMON.GEO'
7025 include 'COMMON.FFIELD'
7026 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7027 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7030 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7031 cd & ' jj=',jj,' kk=',kk
7032 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7035 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7036 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7039 call transpose2(aa1(1,1),aa1t(1,1))
7040 call transpose2(aa2(1,1),aa2t(1,1))
7043 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7044 & aa1tder(1,1,lll,kkk))
7045 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7046 & aa2tder(1,1,lll,kkk))
7050 C parallel orientation of the two CA-CA-CA frames.
7052 iti=itortyp(itype(i))
7056 itk1=itortyp(itype(k+1))
7057 itj=itortyp(itype(j))
7058 if (l.lt.nres-1) then
7059 itl1=itortyp(itype(l+1))
7063 C A1 kernel(j+1) A2T
7065 cd write (iout,'(3f10.5,5x,3f10.5)')
7066 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7068 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7069 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7070 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7071 C Following matrices are needed only for 6-th order cumulants
7072 IF (wcorr6.gt.0.0d0) THEN
7073 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7074 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7075 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7076 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7077 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7078 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7079 & ADtEAderx(1,1,1,1,1,1))
7081 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7082 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7083 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7084 & ADtEA1derx(1,1,1,1,1,1))
7086 C End 6-th order cumulants
7089 cd write (2,*) 'In calc_eello6'
7091 cd write (2,*) 'iii=',iii
7093 cd write (2,*) 'kkk=',kkk
7095 cd write (2,'(3(2f10.5),5x)')
7096 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7101 call transpose2(EUgder(1,1,k),auxmat(1,1))
7102 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7103 call transpose2(EUg(1,1,k),auxmat(1,1))
7104 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7105 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7109 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7110 & EAEAderx(1,1,lll,kkk,iii,1))
7114 C A1T kernel(i+1) A2
7115 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7116 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7117 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7118 C Following matrices are needed only for 6-th order cumulants
7119 IF (wcorr6.gt.0.0d0) THEN
7120 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7121 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7122 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7123 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7124 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7125 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7126 & ADtEAderx(1,1,1,1,1,2))
7127 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7128 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7129 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7130 & ADtEA1derx(1,1,1,1,1,2))
7132 C End 6-th order cumulants
7133 call transpose2(EUgder(1,1,l),auxmat(1,1))
7134 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7135 call transpose2(EUg(1,1,l),auxmat(1,1))
7136 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7137 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7141 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7142 & EAEAderx(1,1,lll,kkk,iii,2))
7147 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7148 C They are needed only when the fifth- or the sixth-order cumulants are
7150 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7151 call transpose2(AEA(1,1,1),auxmat(1,1))
7152 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7153 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7154 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7155 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7156 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7157 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7158 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7159 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7160 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7161 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7162 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7163 call transpose2(AEA(1,1,2),auxmat(1,1))
7164 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7165 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7166 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7167 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7168 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7169 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7170 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7171 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7172 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7173 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7174 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7175 C Calculate the Cartesian derivatives of the vectors.
7179 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7180 call matvec2(auxmat(1,1),b1(1,iti),
7181 & AEAb1derx(1,lll,kkk,iii,1,1))
7182 call matvec2(auxmat(1,1),Ub2(1,i),
7183 & AEAb2derx(1,lll,kkk,iii,1,1))
7184 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7185 & AEAb1derx(1,lll,kkk,iii,2,1))
7186 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7187 & AEAb2derx(1,lll,kkk,iii,2,1))
7188 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7189 call matvec2(auxmat(1,1),b1(1,itj),
7190 & AEAb1derx(1,lll,kkk,iii,1,2))
7191 call matvec2(auxmat(1,1),Ub2(1,j),
7192 & AEAb2derx(1,lll,kkk,iii,1,2))
7193 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7194 & AEAb1derx(1,lll,kkk,iii,2,2))
7195 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7196 & AEAb2derx(1,lll,kkk,iii,2,2))
7203 C Antiparallel orientation of the two CA-CA-CA frames.
7205 iti=itortyp(itype(i))
7209 itk1=itortyp(itype(k+1))
7210 itl=itortyp(itype(l))
7211 itj=itortyp(itype(j))
7212 if (j.lt.nres-1) then
7213 itj1=itortyp(itype(j+1))
7217 C A2 kernel(j-1)T A1T
7218 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7219 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7220 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7221 C Following matrices are needed only for 6-th order cumulants
7222 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7223 & j.eq.i+4 .and. l.eq.i+3)) THEN
7224 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7225 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7226 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7227 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7228 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7229 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7230 & ADtEAderx(1,1,1,1,1,1))
7231 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7232 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7233 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7234 & ADtEA1derx(1,1,1,1,1,1))
7236 C End 6-th order cumulants
7237 call transpose2(EUgder(1,1,k),auxmat(1,1))
7238 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7239 call transpose2(EUg(1,1,k),auxmat(1,1))
7240 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7241 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7245 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7246 & EAEAderx(1,1,lll,kkk,iii,1))
7250 C A2T kernel(i+1)T A1
7251 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7252 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7253 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7254 C Following matrices are needed only for 6-th order cumulants
7255 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7256 & j.eq.i+4 .and. l.eq.i+3)) THEN
7257 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7258 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7259 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7260 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7261 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7262 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7263 & ADtEAderx(1,1,1,1,1,2))
7264 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7265 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7266 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7267 & ADtEA1derx(1,1,1,1,1,2))
7269 C End 6-th order cumulants
7270 call transpose2(EUgder(1,1,j),auxmat(1,1))
7271 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7272 call transpose2(EUg(1,1,j),auxmat(1,1))
7273 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7274 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7278 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7279 & EAEAderx(1,1,lll,kkk,iii,2))
7284 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7285 C They are needed only when the fifth- or the sixth-order cumulants are
7287 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7288 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7289 call transpose2(AEA(1,1,1),auxmat(1,1))
7290 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7291 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7292 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7293 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7294 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7295 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7296 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7297 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7298 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7299 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7300 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7301 call transpose2(AEA(1,1,2),auxmat(1,1))
7302 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7303 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7304 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7305 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7306 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7307 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7308 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7309 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7310 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7311 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7312 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7313 C Calculate the Cartesian derivatives of the vectors.
7317 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7318 call matvec2(auxmat(1,1),b1(1,iti),
7319 & AEAb1derx(1,lll,kkk,iii,1,1))
7320 call matvec2(auxmat(1,1),Ub2(1,i),
7321 & AEAb2derx(1,lll,kkk,iii,1,1))
7322 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7323 & AEAb1derx(1,lll,kkk,iii,2,1))
7324 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7325 & AEAb2derx(1,lll,kkk,iii,2,1))
7326 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7327 call matvec2(auxmat(1,1),b1(1,itl),
7328 & AEAb1derx(1,lll,kkk,iii,1,2))
7329 call matvec2(auxmat(1,1),Ub2(1,l),
7330 & AEAb2derx(1,lll,kkk,iii,1,2))
7331 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7332 & AEAb1derx(1,lll,kkk,iii,2,2))
7333 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7334 & AEAb2derx(1,lll,kkk,iii,2,2))
7343 C---------------------------------------------------------------------------
7344 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7345 & KK,KKderg,AKA,AKAderg,AKAderx)
7349 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7350 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7351 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7356 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7358 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7361 cd if (lprn) write (2,*) 'In kernel'
7363 cd if (lprn) write (2,*) 'kkk=',kkk
7365 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7366 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7368 cd write (2,*) 'lll=',lll
7369 cd write (2,*) 'iii=1'
7371 cd write (2,'(3(2f10.5),5x)')
7372 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7375 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7376 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7378 cd write (2,*) 'lll=',lll
7379 cd write (2,*) 'iii=2'
7381 cd write (2,'(3(2f10.5),5x)')
7382 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7389 C---------------------------------------------------------------------------
7390 double precision function eello4(i,j,k,l,jj,kk)
7391 implicit real*8 (a-h,o-z)
7392 include 'DIMENSIONS'
7393 include 'DIMENSIONS.ZSCOPT'
7394 include 'COMMON.IOUNITS'
7395 include 'COMMON.CHAIN'
7396 include 'COMMON.DERIV'
7397 include 'COMMON.INTERACT'
7398 include 'COMMON.CONTACTS'
7399 include 'COMMON.TORSION'
7400 include 'COMMON.VAR'
7401 include 'COMMON.GEO'
7402 double precision pizda(2,2),ggg1(3),ggg2(3)
7403 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7407 cd print *,'eello4:',i,j,k,l,jj,kk
7408 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7409 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7410 cold eij=facont_hb(jj,i)
7411 cold ekl=facont_hb(kk,k)
7413 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7415 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7416 gcorr_loc(k-1)=gcorr_loc(k-1)
7417 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7419 gcorr_loc(l-1)=gcorr_loc(l-1)
7420 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7422 gcorr_loc(j-1)=gcorr_loc(j-1)
7423 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7428 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7429 & -EAEAderx(2,2,lll,kkk,iii,1)
7430 cd derx(lll,kkk,iii)=0.0d0
7434 cd gcorr_loc(l-1)=0.0d0
7435 cd gcorr_loc(j-1)=0.0d0
7436 cd gcorr_loc(k-1)=0.0d0
7438 cd write (iout,*)'Contacts have occurred for peptide groups',
7439 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7440 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7441 if (j.lt.nres-1) then
7448 if (l.lt.nres-1) then
7456 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
7457 ggg1(ll)=eel4*g_contij(ll,1)
7458 ggg2(ll)=eel4*g_contij(ll,2)
7459 ghalf=0.5d0*ggg1(ll)
7461 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
7462 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7463 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
7464 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7465 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
7466 ghalf=0.5d0*ggg2(ll)
7468 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
7469 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7470 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
7471 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7476 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
7477 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7482 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
7483 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7489 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7494 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7498 cd write (2,*) iii,gcorr_loc(iii)
7502 cd write (2,*) 'ekont',ekont
7503 cd write (iout,*) 'eello4',ekont*eel4
7506 C---------------------------------------------------------------------------
7507 double precision function eello5(i,j,k,l,jj,kk)
7508 implicit real*8 (a-h,o-z)
7509 include 'DIMENSIONS'
7510 include 'DIMENSIONS.ZSCOPT'
7511 include 'COMMON.IOUNITS'
7512 include 'COMMON.CHAIN'
7513 include 'COMMON.DERIV'
7514 include 'COMMON.INTERACT'
7515 include 'COMMON.CONTACTS'
7516 include 'COMMON.TORSION'
7517 include 'COMMON.VAR'
7518 include 'COMMON.GEO'
7519 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7520 double precision ggg1(3),ggg2(3)
7521 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7526 C /l\ / \ \ / \ / \ / C
7527 C / \ / \ \ / \ / \ / C
7528 C j| o |l1 | o | o| o | | o |o C
7529 C \ |/k\| |/ \| / |/ \| |/ \| C
7530 C \i/ \ / \ / / \ / \ C
7532 C (I) (II) (III) (IV) C
7534 C eello5_1 eello5_2 eello5_3 eello5_4 C
7536 C Antiparallel chains C
7539 C /j\ / \ \ / \ / \ / C
7540 C / \ / \ \ / \ / \ / C
7541 C j1| o |l | o | o| o | | o |o C
7542 C \ |/k\| |/ \| / |/ \| |/ \| C
7543 C \i/ \ / \ / / \ / \ C
7545 C (I) (II) (III) (IV) C
7547 C eello5_1 eello5_2 eello5_3 eello5_4 C
7549 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7551 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7552 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7557 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7559 itk=itortyp(itype(k))
7560 itl=itortyp(itype(l))
7561 itj=itortyp(itype(j))
7566 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7567 cd & eel5_3_num,eel5_4_num)
7571 derx(lll,kkk,iii)=0.0d0
7575 cd eij=facont_hb(jj,i)
7576 cd ekl=facont_hb(kk,k)
7578 cd write (iout,*)'Contacts have occurred for peptide groups',
7579 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7581 C Contribution from the graph I.
7582 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7583 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7584 call transpose2(EUg(1,1,k),auxmat(1,1))
7585 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7586 vv(1)=pizda(1,1)-pizda(2,2)
7587 vv(2)=pizda(1,2)+pizda(2,1)
7588 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7589 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7591 C Explicit gradient in virtual-dihedral angles.
7592 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7593 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7594 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7595 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7596 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7597 vv(1)=pizda(1,1)-pizda(2,2)
7598 vv(2)=pizda(1,2)+pizda(2,1)
7599 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7600 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7601 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7602 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7603 vv(1)=pizda(1,1)-pizda(2,2)
7604 vv(2)=pizda(1,2)+pizda(2,1)
7606 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7607 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7608 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7610 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7611 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7612 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7614 C Cartesian gradient
7618 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7620 vv(1)=pizda(1,1)-pizda(2,2)
7621 vv(2)=pizda(1,2)+pizda(2,1)
7622 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7623 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7624 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7631 C Contribution from graph II
7632 call transpose2(EE(1,1,itk),auxmat(1,1))
7633 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7634 vv(1)=pizda(1,1)+pizda(2,2)
7635 vv(2)=pizda(2,1)-pizda(1,2)
7636 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7637 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7639 C Explicit gradient in virtual-dihedral angles.
7640 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7641 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7642 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7643 vv(1)=pizda(1,1)+pizda(2,2)
7644 vv(2)=pizda(2,1)-pizda(1,2)
7646 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7647 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7648 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7650 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7651 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7652 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7654 C Cartesian gradient
7658 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7660 vv(1)=pizda(1,1)+pizda(2,2)
7661 vv(2)=pizda(2,1)-pizda(1,2)
7662 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7663 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7664 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7673 C Parallel orientation
7674 C Contribution from graph III
7675 call transpose2(EUg(1,1,l),auxmat(1,1))
7676 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7677 vv(1)=pizda(1,1)-pizda(2,2)
7678 vv(2)=pizda(1,2)+pizda(2,1)
7679 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7680 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7682 C Explicit gradient in virtual-dihedral angles.
7683 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7684 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7685 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7686 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7687 vv(1)=pizda(1,1)-pizda(2,2)
7688 vv(2)=pizda(1,2)+pizda(2,1)
7689 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7690 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7691 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7692 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7693 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7694 vv(1)=pizda(1,1)-pizda(2,2)
7695 vv(2)=pizda(1,2)+pizda(2,1)
7696 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7697 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7698 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7699 C Cartesian gradient
7703 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7705 vv(1)=pizda(1,1)-pizda(2,2)
7706 vv(2)=pizda(1,2)+pizda(2,1)
7707 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7708 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7709 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7715 C Contribution from graph IV
7717 call transpose2(EE(1,1,itl),auxmat(1,1))
7718 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7719 vv(1)=pizda(1,1)+pizda(2,2)
7720 vv(2)=pizda(2,1)-pizda(1,2)
7721 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7722 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7724 C Explicit gradient in virtual-dihedral angles.
7725 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7726 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7727 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7728 vv(1)=pizda(1,1)+pizda(2,2)
7729 vv(2)=pizda(2,1)-pizda(1,2)
7730 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7731 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7732 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7733 C Cartesian gradient
7737 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7739 vv(1)=pizda(1,1)+pizda(2,2)
7740 vv(2)=pizda(2,1)-pizda(1,2)
7741 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7742 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7743 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7749 C Antiparallel orientation
7750 C Contribution from graph III
7752 call transpose2(EUg(1,1,j),auxmat(1,1))
7753 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7754 vv(1)=pizda(1,1)-pizda(2,2)
7755 vv(2)=pizda(1,2)+pizda(2,1)
7756 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7757 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7759 C Explicit gradient in virtual-dihedral angles.
7760 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7761 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7762 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7763 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7764 vv(1)=pizda(1,1)-pizda(2,2)
7765 vv(2)=pizda(1,2)+pizda(2,1)
7766 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7767 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7768 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7769 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7770 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7771 vv(1)=pizda(1,1)-pizda(2,2)
7772 vv(2)=pizda(1,2)+pizda(2,1)
7773 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7774 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7775 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7776 C Cartesian gradient
7780 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7782 vv(1)=pizda(1,1)-pizda(2,2)
7783 vv(2)=pizda(1,2)+pizda(2,1)
7784 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7785 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7786 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7792 C Contribution from graph IV
7794 call transpose2(EE(1,1,itj),auxmat(1,1))
7795 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7796 vv(1)=pizda(1,1)+pizda(2,2)
7797 vv(2)=pizda(2,1)-pizda(1,2)
7798 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7799 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7801 C Explicit gradient in virtual-dihedral angles.
7802 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7803 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7804 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7805 vv(1)=pizda(1,1)+pizda(2,2)
7806 vv(2)=pizda(2,1)-pizda(1,2)
7807 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7808 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7809 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7810 C Cartesian gradient
7814 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7816 vv(1)=pizda(1,1)+pizda(2,2)
7817 vv(2)=pizda(2,1)-pizda(1,2)
7818 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7819 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7820 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7827 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7828 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7829 cd write (2,*) 'ijkl',i,j,k,l
7830 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7831 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7833 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7834 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7835 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7836 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7838 if (j.lt.nres-1) then
7845 if (l.lt.nres-1) then
7855 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7857 ggg1(ll)=eel5*g_contij(ll,1)
7858 ggg2(ll)=eel5*g_contij(ll,2)
7859 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7860 ghalf=0.5d0*ggg1(ll)
7862 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7863 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7864 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7865 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7866 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7867 ghalf=0.5d0*ggg2(ll)
7869 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7870 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7871 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7872 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7877 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7878 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7883 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7884 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7890 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7895 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7899 cd write (2,*) iii,g_corr5_loc(iii)
7903 cd write (2,*) 'ekont',ekont
7904 cd write (iout,*) 'eello5',ekont*eel5
7907 c--------------------------------------------------------------------------
7908 double precision function eello6(i,j,k,l,jj,kk)
7909 implicit real*8 (a-h,o-z)
7910 include 'DIMENSIONS'
7911 include 'DIMENSIONS.ZSCOPT'
7912 include 'COMMON.IOUNITS'
7913 include 'COMMON.CHAIN'
7914 include 'COMMON.DERIV'
7915 include 'COMMON.INTERACT'
7916 include 'COMMON.CONTACTS'
7917 include 'COMMON.TORSION'
7918 include 'COMMON.VAR'
7919 include 'COMMON.GEO'
7920 include 'COMMON.FFIELD'
7921 double precision ggg1(3),ggg2(3)
7922 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7927 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7935 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7936 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7940 derx(lll,kkk,iii)=0.0d0
7944 cd eij=facont_hb(jj,i)
7945 cd ekl=facont_hb(kk,k)
7951 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7952 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7953 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7954 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7955 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7956 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7958 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7959 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7960 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7961 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7962 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7963 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7967 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7969 C If turn contributions are considered, they will be handled separately.
7970 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7971 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7972 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7973 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7974 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7975 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7976 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7979 if (j.lt.nres-1) then
7986 if (l.lt.nres-1) then
7994 ggg1(ll)=eel6*g_contij(ll,1)
7995 ggg2(ll)=eel6*g_contij(ll,2)
7996 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7997 ghalf=0.5d0*ggg1(ll)
7999 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
8000 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8001 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
8002 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8003 ghalf=0.5d0*ggg2(ll)
8004 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8006 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
8007 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8008 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
8009 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8014 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8015 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8020 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8021 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8027 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8032 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8036 cd write (2,*) iii,g_corr6_loc(iii)
8040 cd write (2,*) 'ekont',ekont
8041 cd write (iout,*) 'eello6',ekont*eel6
8044 c--------------------------------------------------------------------------
8045 double precision function eello6_graph1(i,j,k,l,imat,swap)
8046 implicit real*8 (a-h,o-z)
8047 include 'DIMENSIONS'
8048 include 'DIMENSIONS.ZSCOPT'
8049 include 'COMMON.IOUNITS'
8050 include 'COMMON.CHAIN'
8051 include 'COMMON.DERIV'
8052 include 'COMMON.INTERACT'
8053 include 'COMMON.CONTACTS'
8054 include 'COMMON.TORSION'
8055 include 'COMMON.VAR'
8056 include 'COMMON.GEO'
8057 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8061 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8063 C Parallel Antiparallel
8069 C \ j|/k\| / \ |/k\|l /
8074 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8075 itk=itortyp(itype(k))
8076 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8077 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8078 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8079 call transpose2(EUgC(1,1,k),auxmat(1,1))
8080 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8081 vv1(1)=pizda1(1,1)-pizda1(2,2)
8082 vv1(2)=pizda1(1,2)+pizda1(2,1)
8083 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8084 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8085 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8086 s5=scalar2(vv(1),Dtobr2(1,i))
8087 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8088 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8089 if (.not. calc_grad) return
8090 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8091 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8092 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8093 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8094 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8095 & +scalar2(vv(1),Dtobr2der(1,i)))
8096 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8097 vv1(1)=pizda1(1,1)-pizda1(2,2)
8098 vv1(2)=pizda1(1,2)+pizda1(2,1)
8099 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8100 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8102 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8103 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8104 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8105 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8106 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8108 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8109 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8110 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8111 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8112 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8114 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8115 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8116 vv1(1)=pizda1(1,1)-pizda1(2,2)
8117 vv1(2)=pizda1(1,2)+pizda1(2,1)
8118 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8119 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8120 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8121 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8130 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8131 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8132 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8133 call transpose2(EUgC(1,1,k),auxmat(1,1))
8134 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8136 vv1(1)=pizda1(1,1)-pizda1(2,2)
8137 vv1(2)=pizda1(1,2)+pizda1(2,1)
8138 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8139 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8140 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8141 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8142 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8143 s5=scalar2(vv(1),Dtobr2(1,i))
8144 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8150 c----------------------------------------------------------------------------
8151 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8152 implicit real*8 (a-h,o-z)
8153 include 'DIMENSIONS'
8154 include 'DIMENSIONS.ZSCOPT'
8155 include 'COMMON.IOUNITS'
8156 include 'COMMON.CHAIN'
8157 include 'COMMON.DERIV'
8158 include 'COMMON.INTERACT'
8159 include 'COMMON.CONTACTS'
8160 include 'COMMON.TORSION'
8161 include 'COMMON.VAR'
8162 include 'COMMON.GEO'
8164 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8165 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8168 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8170 C Parallel Antiparallel
8181 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8182 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8183 C AL 7/4/01 s1 would occur in the sixth-order moment,
8184 C but not in a cluster cumulant
8186 s1=dip(1,jj,i)*dip(1,kk,k)
8188 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8189 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8190 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8191 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8192 call transpose2(EUg(1,1,k),auxmat(1,1))
8193 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8194 vv(1)=pizda(1,1)-pizda(2,2)
8195 vv(2)=pizda(1,2)+pizda(2,1)
8196 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8197 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8199 eello6_graph2=-(s1+s2+s3+s4)
8201 eello6_graph2=-(s2+s3+s4)
8204 if (.not. calc_grad) return
8205 C Derivatives in gamma(i-1)
8208 s1=dipderg(1,jj,i)*dip(1,kk,k)
8210 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8211 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8212 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8213 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8215 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8217 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8219 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8221 C Derivatives in gamma(k-1)
8223 s1=dip(1,jj,i)*dipderg(1,kk,k)
8225 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8226 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8227 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8228 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8229 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8230 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8231 vv(1)=pizda(1,1)-pizda(2,2)
8232 vv(2)=pizda(1,2)+pizda(2,1)
8233 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8235 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8237 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8239 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8240 C Derivatives in gamma(j-1) or gamma(l-1)
8243 s1=dipderg(3,jj,i)*dip(1,kk,k)
8245 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8246 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8247 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8248 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8249 vv(1)=pizda(1,1)-pizda(2,2)
8250 vv(2)=pizda(1,2)+pizda(2,1)
8251 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8254 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8256 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8259 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8260 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8262 C Derivatives in gamma(l-1) or gamma(j-1)
8265 s1=dip(1,jj,i)*dipderg(3,kk,k)
8267 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8268 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8269 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8270 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8271 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8272 vv(1)=pizda(1,1)-pizda(2,2)
8273 vv(2)=pizda(1,2)+pizda(2,1)
8274 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8277 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8279 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8282 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8283 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8285 C Cartesian derivatives.
8287 write (2,*) 'In eello6_graph2'
8289 write (2,*) 'iii=',iii
8291 write (2,*) 'kkk=',kkk
8293 write (2,'(3(2f10.5),5x)')
8294 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8304 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8306 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8309 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8311 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8312 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8314 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8315 call transpose2(EUg(1,1,k),auxmat(1,1))
8316 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8318 vv(1)=pizda(1,1)-pizda(2,2)
8319 vv(2)=pizda(1,2)+pizda(2,1)
8320 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8321 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8323 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8325 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8328 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8330 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8337 c----------------------------------------------------------------------------
8338 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8339 implicit real*8 (a-h,o-z)
8340 include 'DIMENSIONS'
8341 include 'DIMENSIONS.ZSCOPT'
8342 include 'COMMON.IOUNITS'
8343 include 'COMMON.CHAIN'
8344 include 'COMMON.DERIV'
8345 include 'COMMON.INTERACT'
8346 include 'COMMON.CONTACTS'
8347 include 'COMMON.TORSION'
8348 include 'COMMON.VAR'
8349 include 'COMMON.GEO'
8350 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8352 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8354 C Parallel Antiparallel
8365 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8367 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8368 C energy moment and not to the cluster cumulant.
8369 iti=itortyp(itype(i))
8370 if (j.lt.nres-1) then
8371 itj1=itortyp(itype(j+1))
8375 itk=itortyp(itype(k))
8376 itk1=itortyp(itype(k+1))
8377 if (l.lt.nres-1) then
8378 itl1=itortyp(itype(l+1))
8383 s1=dip(4,jj,i)*dip(4,kk,k)
8385 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8386 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8387 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8388 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8389 call transpose2(EE(1,1,itk),auxmat(1,1))
8390 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8391 vv(1)=pizda(1,1)+pizda(2,2)
8392 vv(2)=pizda(2,1)-pizda(1,2)
8393 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8394 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8396 eello6_graph3=-(s1+s2+s3+s4)
8398 eello6_graph3=-(s2+s3+s4)
8401 if (.not. calc_grad) return
8402 C Derivatives in gamma(k-1)
8403 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8404 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8405 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8406 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8407 C Derivatives in gamma(l-1)
8408 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8409 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8410 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8411 vv(1)=pizda(1,1)+pizda(2,2)
8412 vv(2)=pizda(2,1)-pizda(1,2)
8413 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8414 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8415 C Cartesian derivatives.
8421 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8423 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8426 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8428 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8429 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8431 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8432 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8434 vv(1)=pizda(1,1)+pizda(2,2)
8435 vv(2)=pizda(2,1)-pizda(1,2)
8436 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8438 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8440 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8443 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8445 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8447 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8453 c----------------------------------------------------------------------------
8454 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8455 implicit real*8 (a-h,o-z)
8456 include 'DIMENSIONS'
8457 include 'DIMENSIONS.ZSCOPT'
8458 include 'COMMON.IOUNITS'
8459 include 'COMMON.CHAIN'
8460 include 'COMMON.DERIV'
8461 include 'COMMON.INTERACT'
8462 include 'COMMON.CONTACTS'
8463 include 'COMMON.TORSION'
8464 include 'COMMON.VAR'
8465 include 'COMMON.GEO'
8466 include 'COMMON.FFIELD'
8467 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8468 & auxvec1(2),auxmat1(2,2)
8470 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8472 C Parallel Antiparallel
8483 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8485 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8486 C energy moment and not to the cluster cumulant.
8487 cd write (2,*) 'eello_graph4: wturn6',wturn6
8488 iti=itortyp(itype(i))
8489 itj=itortyp(itype(j))
8490 if (j.lt.nres-1) then
8491 itj1=itortyp(itype(j+1))
8495 itk=itortyp(itype(k))
8496 if (k.lt.nres-1) then
8497 itk1=itortyp(itype(k+1))
8501 itl=itortyp(itype(l))
8502 if (l.lt.nres-1) then
8503 itl1=itortyp(itype(l+1))
8507 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8508 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8509 cd & ' itl',itl,' itl1',itl1
8512 s1=dip(3,jj,i)*dip(3,kk,k)
8514 s1=dip(2,jj,j)*dip(2,kk,l)
8517 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8518 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8520 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8521 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8523 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8524 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8526 call transpose2(EUg(1,1,k),auxmat(1,1))
8527 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8528 vv(1)=pizda(1,1)-pizda(2,2)
8529 vv(2)=pizda(2,1)+pizda(1,2)
8530 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8531 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8533 eello6_graph4=-(s1+s2+s3+s4)
8535 eello6_graph4=-(s2+s3+s4)
8537 if (.not. calc_grad) return
8538 C Derivatives in gamma(i-1)
8542 s1=dipderg(2,jj,i)*dip(3,kk,k)
8544 s1=dipderg(4,jj,j)*dip(2,kk,l)
8547 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8549 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8550 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8552 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8553 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8555 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8556 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8557 cd write (2,*) 'turn6 derivatives'
8559 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8561 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8565 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8567 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8571 C Derivatives in gamma(k-1)
8574 s1=dip(3,jj,i)*dipderg(2,kk,k)
8576 s1=dip(2,jj,j)*dipderg(4,kk,l)
8579 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8580 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8582 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8583 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8585 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8586 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8588 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8589 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8590 vv(1)=pizda(1,1)-pizda(2,2)
8591 vv(2)=pizda(2,1)+pizda(1,2)
8592 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8593 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8595 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8597 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8601 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8603 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8606 C Derivatives in gamma(j-1) or gamma(l-1)
8607 if (l.eq.j+1 .and. l.gt.1) then
8608 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8609 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8610 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8611 vv(1)=pizda(1,1)-pizda(2,2)
8612 vv(2)=pizda(2,1)+pizda(1,2)
8613 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8614 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8615 else if (j.gt.1) then
8616 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8617 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8618 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8619 vv(1)=pizda(1,1)-pizda(2,2)
8620 vv(2)=pizda(2,1)+pizda(1,2)
8621 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8622 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8623 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8625 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8628 C Cartesian derivatives.
8635 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8637 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8641 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8643 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8647 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8649 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8651 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8652 & b1(1,itj1),auxvec(1))
8653 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8655 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8656 & b1(1,itl1),auxvec(1))
8657 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8659 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8661 vv(1)=pizda(1,1)-pizda(2,2)
8662 vv(2)=pizda(2,1)+pizda(1,2)
8663 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8665 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8667 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8670 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8673 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8676 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8678 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8680 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8684 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8686 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8689 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8691 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8699 c----------------------------------------------------------------------------
8700 double precision function eello_turn6(i,jj,kk)
8701 implicit real*8 (a-h,o-z)
8702 include 'DIMENSIONS'
8703 include 'DIMENSIONS.ZSCOPT'
8704 include 'COMMON.IOUNITS'
8705 include 'COMMON.CHAIN'
8706 include 'COMMON.DERIV'
8707 include 'COMMON.INTERACT'
8708 include 'COMMON.CONTACTS'
8709 include 'COMMON.TORSION'
8710 include 'COMMON.VAR'
8711 include 'COMMON.GEO'
8712 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8713 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8715 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8716 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8717 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8718 C the respective energy moment and not to the cluster cumulant.
8723 iti=itortyp(itype(i))
8724 itk=itortyp(itype(k))
8725 itk1=itortyp(itype(k+1))
8726 itl=itortyp(itype(l))
8727 itj=itortyp(itype(j))
8728 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8729 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8730 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8735 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8737 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8741 derx_turn(lll,kkk,iii)=0.0d0
8748 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8750 cd write (2,*) 'eello6_5',eello6_5
8752 call transpose2(AEA(1,1,1),auxmat(1,1))
8753 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8754 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8755 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8759 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8760 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8761 s2 = scalar2(b1(1,itk),vtemp1(1))
8763 call transpose2(AEA(1,1,2),atemp(1,1))
8764 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8765 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8766 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8770 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8771 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8772 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8774 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8775 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8776 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8777 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8778 ss13 = scalar2(b1(1,itk),vtemp4(1))
8779 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8783 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8789 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8791 C Derivatives in gamma(i+2)
8793 call transpose2(AEA(1,1,1),auxmatd(1,1))
8794 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8795 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8796 call transpose2(AEAderg(1,1,2),atempd(1,1))
8797 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8798 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8802 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8803 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8804 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8810 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8811 C Derivatives in gamma(i+3)
8813 call transpose2(AEA(1,1,1),auxmatd(1,1))
8814 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8815 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8816 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8820 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8821 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8822 s2d = scalar2(b1(1,itk),vtemp1d(1))
8824 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8825 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8827 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8829 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8830 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8831 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8841 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8842 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8844 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8845 & -0.5d0*ekont*(s2d+s12d)
8847 C Derivatives in gamma(i+4)
8848 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8849 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8850 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8852 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8853 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8854 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8864 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8866 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8868 C Derivatives in gamma(i+5)
8870 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8871 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8872 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8876 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8877 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8878 s2d = scalar2(b1(1,itk),vtemp1d(1))
8880 call transpose2(AEA(1,1,2),atempd(1,1))
8881 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8882 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8886 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8887 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8889 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8890 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8891 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8901 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8902 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8904 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8905 & -0.5d0*ekont*(s2d+s12d)
8907 C Cartesian derivatives
8912 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8913 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8914 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8918 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8919 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8921 s2d = scalar2(b1(1,itk),vtemp1d(1))
8923 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8924 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8925 s8d = -(atempd(1,1)+atempd(2,2))*
8926 & scalar2(cc(1,1,itl),vtemp2(1))
8930 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8932 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8933 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8940 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8943 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8947 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8948 & - 0.5d0*(s8d+s12d)
8950 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8959 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8961 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8962 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8963 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8964 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8965 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8967 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8968 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8969 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8973 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8974 cd & 16*eel_turn6_num
8976 if (j.lt.nres-1) then
8983 if (l.lt.nres-1) then
8991 ggg1(ll)=eel_turn6*g_contij(ll,1)
8992 ggg2(ll)=eel_turn6*g_contij(ll,2)
8993 ghalf=0.5d0*ggg1(ll)
8995 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8996 & +ekont*derx_turn(ll,2,1)
8997 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8998 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8999 & +ekont*derx_turn(ll,4,1)
9000 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9001 ghalf=0.5d0*ggg2(ll)
9003 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
9004 & +ekont*derx_turn(ll,2,2)
9005 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9006 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
9007 & +ekont*derx_turn(ll,4,2)
9008 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9013 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9018 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9024 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9029 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9033 cd write (2,*) iii,g_corr6_loc(iii)
9036 eello_turn6=ekont*eel_turn6
9037 cd write (2,*) 'ekont',ekont
9038 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9041 crc-------------------------------------------------
9042 SUBROUTINE MATVEC2(A1,V1,V2)
9043 implicit real*8 (a-h,o-z)
9044 include 'DIMENSIONS'
9045 DIMENSION A1(2,2),V1(2),V2(2)
9049 c 3 VI=VI+A1(I,K)*V1(K)
9053 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9054 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9059 C---------------------------------------
9060 SUBROUTINE MATMAT2(A1,A2,A3)
9061 implicit real*8 (a-h,o-z)
9062 include 'DIMENSIONS'
9063 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9064 c DIMENSION AI3(2,2)
9068 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9074 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9075 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9076 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9077 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9085 c-------------------------------------------------------------------------
9086 double precision function scalar2(u,v)
9088 double precision u(2),v(2)
9091 scalar2=u(1)*v(1)+u(2)*v(2)
9095 C-----------------------------------------------------------------------------
9097 subroutine transpose2(a,at)
9099 double precision a(2,2),at(2,2)
9106 c--------------------------------------------------------------------------
9107 subroutine transpose(n,a,at)
9110 double precision a(n,n),at(n,n)
9118 C---------------------------------------------------------------------------
9119 subroutine prodmat3(a1,a2,kk,transp,prod)
9122 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9124 crc double precision auxmat(2,2),prod_(2,2)
9127 crc call transpose2(kk(1,1),auxmat(1,1))
9128 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9129 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9131 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9132 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9133 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9134 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9135 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9136 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9137 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9138 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9141 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9142 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9144 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9145 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9146 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9147 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9148 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9149 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9150 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9151 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9154 c call transpose2(a2(1,1),a2t(1,1))
9157 crc print *,((prod_(i,j),i=1,2),j=1,2)
9158 crc print *,((prod(i,j),i=1,2),j=1,2)
9162 C-----------------------------------------------------------------------------
9163 double precision function scalar(u,v)
9165 double precision u(3),v(3)