1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 double precision fact(6)
26 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
27 cd print *,'nnt=',nnt,' nct=',nct
29 C Compute the side-chain and electrostatic interaction energy
31 goto (101,102,103,104,105) ipot
32 C Lennard-Jones potential.
33 101 call elj(evdw,evdw_t)
34 cd print '(a)','Exit ELJ'
36 C Lennard-Jones-Kihara potential (shifted).
37 102 call eljk(evdw,evdw_t)
39 C Berne-Pechukas potential (dilated LJ, angular dependence).
40 103 call ebp(evdw,evdw_t)
42 C Gay-Berne potential (shifted LJ, angular dependence).
43 104 call egb(evdw,evdw_t)
45 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
46 105 call egbv(evdw,evdw_t)
48 C Calculate electrostatic (H-bonding) energy of the main chain.
50 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
52 C Calculate excluded-volume interaction energy between peptide groups
55 call escp(evdw2,evdw2_14)
57 c Calculate the bond-stretching energy
60 c write (iout,*) "estr",estr
62 C Calculate the disulfide-bridge and other energy and the contributions
63 C from other distance constraints.
64 cd print *,'Calling EHPB'
66 cd print *,'EHPB exitted succesfully.'
68 C Calculate the virtual-bond-angle energy.
71 cd print *,'Bend energy finished.'
73 C Calculate the SC local energy.
76 cd print *,'SCLOC energy finished.'
78 C Calculate the virtual-bond torsional energy.
80 cd print *,'nterm=',nterm
81 call etor(etors,edihcnstr,fact(1))
83 C 6/23/01 Calculate double-torsional energy
85 call etor_d(etors_d,fact(2))
87 C 21/5/07 Calculate local sicdechain correlation energy
89 call eback_sc_corr(esccor)
91 C 12/1/95 Multi-body terms
95 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
96 & .or. wturn6.gt.0.0d0) then
97 c print *,"calling multibody_eello"
98 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
99 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
100 c print *,ecorr,ecorr5,ecorr6,eturn6
102 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
103 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
105 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
107 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
109 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
110 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
111 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
112 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
113 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
114 & +wbond*estr+wsccor*fact(1)*esccor
116 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
117 & +welec*fact(1)*(ees+evdw1)
118 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
119 & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
120 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
121 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
122 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
123 & +wbond*estr+wsccor*fact(1)*esccor
127 c call enerprint(energia(0),frac)
129 energia(2)=evdw2-evdw2_14
146 energia(8)=eello_turn3
147 energia(9)=eello_turn4
156 energia(20)=edihcnstr
161 if (isnan(etot).ne.0) energia(0)=1.0d+99
163 if (isnan(etot)) energia(0)=1.0d+99
168 idumm=proc_proc(etot,i)
170 call proc_proc(etot,i)
172 if(i.eq.1)energia(0)=1.0d+99
179 C Sum up the components of the Cartesian gradient.
184 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
185 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
187 & wstrain*ghpbc(j,i)+
188 & wcorr*fact(3)*gradcorr(j,i)+
189 & wel_loc*fact(2)*gel_loc(j,i)+
190 & wturn3*fact(2)*gcorr3_turn(j,i)+
191 & wturn4*fact(3)*gcorr4_turn(j,i)+
192 & wcorr5*fact(4)*gradcorr5(j,i)+
193 & wcorr6*fact(5)*gradcorr6(j,i)+
194 & wturn6*fact(5)*gcorr6_turn(j,i)+
195 & wsccor*fact(2)*gsccorc(j,i)
196 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
198 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
199 & wsccor*fact(2)*gsccorx(j,i)
204 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
205 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
207 & wcorr*fact(3)*gradcorr(j,i)+
208 & wel_loc*fact(2)*gel_loc(j,i)+
209 & wturn3*fact(2)*gcorr3_turn(j,i)+
210 & wturn4*fact(3)*gcorr4_turn(j,i)+
211 & wcorr5*fact(4)*gradcorr5(j,i)+
212 & wcorr6*fact(5)*gradcorr6(j,i)+
213 & wturn6*fact(5)*gcorr6_turn(j,i)+
214 & wsccor*fact(2)*gsccorc(j,i)
215 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
217 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
218 & wsccor*fact(1)*gsccorx(j,i)
225 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
226 & +wcorr5*fact(4)*g_corr5_loc(i)
227 & +wcorr6*fact(5)*g_corr6_loc(i)
228 & +wturn4*fact(3)*gel_loc_turn4(i)
229 & +wturn3*fact(2)*gel_loc_turn3(i)
230 & +wturn6*fact(5)*gel_loc_turn6(i)
231 & +wel_loc*fact(2)*gel_loc_loc(i)
232 & +wsccor*fact(1)*gsccor_loc(i)
237 C------------------------------------------------------------------------
238 subroutine enerprint(energia,fact)
239 implicit real*8 (a-h,o-z)
241 include 'sizesclu.dat'
242 include 'COMMON.IOUNITS'
243 include 'COMMON.FFIELD'
244 include 'COMMON.SBRIDGE'
245 double precision energia(0:max_ene),fact(6)
247 evdw=energia(1)+fact(6)*energia(21)
249 evdw2=energia(2)+energia(17)
261 eello_turn3=energia(8)
262 eello_turn4=energia(9)
263 eello_turn6=energia(10)
270 edihcnstr=energia(20)
273 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
275 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
276 & etors_d,wtor_d*fact(2),ehpb,wstrain,
277 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
278 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
279 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
280 & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot
281 10 format (/'Virtual-chain energies:'//
282 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
283 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
284 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
285 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
286 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
287 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
288 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
289 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
290 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
291 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
292 & ' (SS bridges & dist. cnstr.)'/
293 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
294 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
295 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
296 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
297 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
298 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
299 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
300 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
301 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
302 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
303 & 'ETOT= ',1pE16.6,' (total)')
305 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
306 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
307 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
308 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
309 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
310 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
311 & edihcnstr,ebr*nss,etot
312 10 format (/'Virtual-chain energies:'//
313 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
314 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
315 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
316 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
317 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
318 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
319 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
320 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
321 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
322 & ' (SS bridges & dist. cnstr.)'/
323 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
324 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
325 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
326 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
327 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
328 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
329 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
330 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
331 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
332 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
333 & 'ETOT= ',1pE16.6,' (total)')
337 C-----------------------------------------------------------------------
338 subroutine elj(evdw,evdw_t)
340 C This subroutine calculates the interaction energy of nonbonded side chains
341 C assuming the LJ potential of interaction.
343 implicit real*8 (a-h,o-z)
345 include 'sizesclu.dat'
346 include "DIMENSIONS.COMPAR"
347 parameter (accur=1.0d-10)
350 include 'COMMON.LOCAL'
351 include 'COMMON.CHAIN'
352 include 'COMMON.DERIV'
353 include 'COMMON.INTERACT'
354 include 'COMMON.TORSION'
355 include 'COMMON.SBRIDGE'
356 include 'COMMON.NAMES'
357 include 'COMMON.IOUNITS'
358 include 'COMMON.CONTACTS'
362 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
367 if (itypi.eq.21) cycle
375 C Calculate SC interaction energy.
378 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
379 cd & 'iend=',iend(i,iint)
380 do j=istart(i,iint),iend(i,iint)
382 if (itypj.eq.21) cycle
386 C Change 12/1/95 to calculate four-body interactions
387 rij=xj*xj+yj*yj+zj*zj
389 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
390 eps0ij=eps(itypi,itypj)
392 e1=fac*fac*aa(itypi,itypj)
393 e2=fac*bb(itypi,itypj)
395 ij=icant(itypi,itypj)
396 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
397 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
398 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
399 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
400 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
401 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
402 if (bb(itypi,itypj).gt.0.0d0) then
409 C Calculate the components of the gradient in DC and X
411 fac=-rrij*(e1+evdwij)
416 gvdwx(k,i)=gvdwx(k,i)-gg(k)
417 gvdwx(k,j)=gvdwx(k,j)+gg(k)
421 gvdwc(l,k)=gvdwc(l,k)+gg(l)
426 C 12/1/95, revised on 5/20/97
428 C Calculate the contact function. The ith column of the array JCONT will
429 C contain the numbers of atoms that make contacts with the atom I (of numbers
430 C greater than I). The arrays FACONT and GACONT will contain the values of
431 C the contact function and its derivative.
433 C Uncomment next line, if the correlation interactions include EVDW explicitly.
434 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
435 C Uncomment next line, if the correlation interactions are contact function only
436 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
438 sigij=sigma(itypi,itypj)
439 r0ij=rs0(itypi,itypj)
441 C Check whether the SC's are not too far to make a contact.
444 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
445 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
447 if (fcont.gt.0.0D0) then
448 C If the SC-SC distance if close to sigma, apply spline.
449 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
450 cAdam & fcont1,fprimcont1)
451 cAdam fcont1=1.0d0-fcont1
452 cAdam if (fcont1.gt.0.0d0) then
453 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
454 cAdam fcont=fcont*fcont1
456 C Uncomment following 4 lines to have the geometric average of the epsilon0's
457 cga eps0ij=1.0d0/dsqrt(eps0ij)
459 cga gg(k)=gg(k)*eps0ij
461 cga eps0ij=-evdwij*eps0ij
462 C Uncomment for AL's type of SC correlation interactions.
464 num_conti=num_conti+1
466 facont(num_conti,i)=fcont*eps0ij
467 fprimcont=eps0ij*fprimcont/rij
469 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
470 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
471 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
472 C Uncomment following 3 lines for Skolnick's type of SC correlation.
473 gacont(1,num_conti,i)=-fprimcont*xj
474 gacont(2,num_conti,i)=-fprimcont*yj
475 gacont(3,num_conti,i)=-fprimcont*zj
476 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
477 cd write (iout,'(2i3,3f10.5)')
478 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
484 num_cont(i)=num_conti
489 gvdwc(j,i)=expon*gvdwc(j,i)
490 gvdwx(j,i)=expon*gvdwx(j,i)
494 C******************************************************************************
498 C To save time, the factor of EXPON has been extracted from ALL components
499 C of GVDWC and GRADX. Remember to multiply them by this factor before further
502 C******************************************************************************
505 C-----------------------------------------------------------------------------
506 subroutine eljk(evdw,evdw_t)
508 C This subroutine calculates the interaction energy of nonbonded side chains
509 C assuming the LJK potential of interaction.
511 implicit real*8 (a-h,o-z)
513 include 'sizesclu.dat'
514 include "DIMENSIONS.COMPAR"
517 include 'COMMON.LOCAL'
518 include 'COMMON.CHAIN'
519 include 'COMMON.DERIV'
520 include 'COMMON.INTERACT'
521 include 'COMMON.IOUNITS'
522 include 'COMMON.NAMES'
527 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
532 if (itypi.eq.21) cycle
538 C Calculate SC interaction energy.
541 do j=istart(i,iint),iend(i,iint)
543 if (itypj.eq.21) cycle
547 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
549 e_augm=augm(itypi,itypj)*fac_augm
552 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
553 fac=r_shift_inv**expon
554 e1=fac*fac*aa(itypi,itypj)
555 e2=fac*bb(itypi,itypj)
557 ij=icant(itypi,itypj)
558 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
559 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
560 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
561 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
562 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
563 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
564 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
565 if (bb(itypi,itypj).gt.0.0d0) then
572 C Calculate the components of the gradient in DC and X
574 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
579 gvdwx(k,i)=gvdwx(k,i)-gg(k)
580 gvdwx(k,j)=gvdwx(k,j)+gg(k)
584 gvdwc(l,k)=gvdwc(l,k)+gg(l)
594 gvdwc(j,i)=expon*gvdwc(j,i)
595 gvdwx(j,i)=expon*gvdwx(j,i)
601 C-----------------------------------------------------------------------------
602 subroutine ebp(evdw,evdw_t)
604 C This subroutine calculates the interaction energy of nonbonded side chains
605 C assuming the Berne-Pechukas potential of interaction.
607 implicit real*8 (a-h,o-z)
609 include 'sizesclu.dat'
610 include "DIMENSIONS.COMPAR"
613 include 'COMMON.LOCAL'
614 include 'COMMON.CHAIN'
615 include 'COMMON.DERIV'
616 include 'COMMON.NAMES'
617 include 'COMMON.INTERACT'
618 include 'COMMON.IOUNITS'
619 include 'COMMON.CALC'
621 c double precision rrsave(maxdim)
627 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
628 c if (icall.eq.0) then
636 if (itypi.eq.21) cycle
641 dxi=dc_norm(1,nres+i)
642 dyi=dc_norm(2,nres+i)
643 dzi=dc_norm(3,nres+i)
644 dsci_inv=vbld_inv(i+nres)
646 C Calculate SC interaction energy.
649 do j=istart(i,iint),iend(i,iint)
652 if (itypj.eq.21) cycle
653 dscj_inv=vbld_inv(j+nres)
654 chi1=chi(itypi,itypj)
655 chi2=chi(itypj,itypi)
662 alf12=0.5D0*(alf1+alf2)
663 C For diagnostics only!!!
676 dxj=dc_norm(1,nres+j)
677 dyj=dc_norm(2,nres+j)
678 dzj=dc_norm(3,nres+j)
679 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
680 cd if (icall.eq.0) then
686 C Calculate the angle-dependent terms of energy & contributions to derivatives.
688 C Calculate whole angle-dependent part of epsilon and contributions
690 fac=(rrij*sigsq)**expon2
691 e1=fac*fac*aa(itypi,itypj)
692 e2=fac*bb(itypi,itypj)
693 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
694 eps2der=evdwij*eps3rt
695 eps3der=evdwij*eps2rt
696 evdwij=evdwij*eps2rt*eps3rt
697 ij=icant(itypi,itypj)
698 aux=eps1*eps2rt**2*eps3rt**2
699 if (bb(itypi,itypj).gt.0.0d0) then
706 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
707 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
708 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
709 cd & restyp(itypi),i,restyp(itypj),j,
710 cd & epsi,sigm,chi1,chi2,chip1,chip2,
711 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
712 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
715 C Calculate gradient components.
716 e1=e1*eps1*eps2rt**2*eps3rt**2
717 fac=-expon*(e1+evdwij)
720 C Calculate radial part of the gradient
724 C Calculate the angular part of the gradient and sum add the contributions
725 C to the appropriate components of the Cartesian gradient.
734 C-----------------------------------------------------------------------------
735 subroutine egb(evdw,evdw_t)
737 C This subroutine calculates the interaction energy of nonbonded side chains
738 C assuming the Gay-Berne potential of interaction.
740 implicit real*8 (a-h,o-z)
742 include 'sizesclu.dat'
743 include "DIMENSIONS.COMPAR"
746 include 'COMMON.LOCAL'
747 include 'COMMON.CHAIN'
748 include 'COMMON.DERIV'
749 include 'COMMON.NAMES'
750 include 'COMMON.INTERACT'
751 include 'COMMON.IOUNITS'
752 include 'COMMON.CALC'
757 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
761 c if (icall.gt.0) lprn=.true.
765 if (itypi.eq.21) cycle
770 dxi=dc_norm(1,nres+i)
771 dyi=dc_norm(2,nres+i)
772 dzi=dc_norm(3,nres+i)
773 dsci_inv=vbld_inv(i+nres)
775 C Calculate SC interaction energy.
778 do j=istart(i,iint),iend(i,iint)
781 if (itypj.eq.21) cycle
782 dscj_inv=vbld_inv(j+nres)
783 sig0ij=sigma(itypi,itypj)
784 chi1=chi(itypi,itypj)
785 chi2=chi(itypj,itypi)
792 alf12=0.5D0*(alf1+alf2)
793 C For diagnostics only!!!
806 dxj=dc_norm(1,nres+j)
807 dyj=dc_norm(2,nres+j)
808 dzj=dc_norm(3,nres+j)
809 c write (iout,*) i,j,xj,yj,zj
810 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
812 C Calculate angle-dependent terms of energy and contributions to their
816 sig=sig0ij*dsqrt(sigsq)
817 rij_shift=1.0D0/rij-sig+sig0ij
818 C I hate to put IF's in the loops, but here don't have another choice!!!!
819 if (rij_shift.le.0.0D0) then
824 c---------------------------------------------------------------
825 rij_shift=1.0D0/rij_shift
827 e1=fac*fac*aa(itypi,itypj)
828 e2=fac*bb(itypi,itypj)
829 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
830 eps2der=evdwij*eps3rt
831 eps3der=evdwij*eps2rt
832 evdwij=evdwij*eps2rt*eps3rt
833 if (bb(itypi,itypj).gt.0) then
838 ij=icant(itypi,itypj)
839 aux=eps1*eps2rt**2*eps3rt**2
840 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
841 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
842 c & aux*e2/eps(itypi,itypj)
844 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
845 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
846 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
847 c & restyp(itypi),i,restyp(itypj),j,
848 c & epsi,sigm,chi1,chi2,chip1,chip2,
849 c & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
850 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
852 c write (iout,*) "pratial sum", evdw,evdw_t
855 C Calculate gradient components.
856 e1=e1*eps1*eps2rt**2*eps3rt**2
857 fac=-expon*(e1+evdwij)*rij_shift
860 C Calculate the radial part of the gradient
864 C Calculate angular part of the gradient.
872 C-----------------------------------------------------------------------------
873 subroutine egbv(evdw,evdw_t)
875 C This subroutine calculates the interaction energy of nonbonded side chains
876 C assuming the Gay-Berne-Vorobjev potential of interaction.
878 implicit real*8 (a-h,o-z)
880 include 'sizesclu.dat'
881 include "DIMENSIONS.COMPAR"
884 include 'COMMON.LOCAL'
885 include 'COMMON.CHAIN'
886 include 'COMMON.DERIV'
887 include 'COMMON.NAMES'
888 include 'COMMON.INTERACT'
889 include 'COMMON.IOUNITS'
890 include 'COMMON.CALC'
897 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
900 c if (icall.gt.0) lprn=.true.
904 if (itypi.eq.21) cycle
909 dxi=dc_norm(1,nres+i)
910 dyi=dc_norm(2,nres+i)
911 dzi=dc_norm(3,nres+i)
912 dsci_inv=vbld_inv(i+nres)
914 C Calculate SC interaction energy.
917 do j=istart(i,iint),iend(i,iint)
920 if (itypj.eq.21) cycle
921 dscj_inv=vbld_inv(j+nres)
922 sig0ij=sigma(itypi,itypj)
924 chi1=chi(itypi,itypj)
925 chi2=chi(itypj,itypi)
932 alf12=0.5D0*(alf1+alf2)
933 C For diagnostics only!!!
946 dxj=dc_norm(1,nres+j)
947 dyj=dc_norm(2,nres+j)
948 dzj=dc_norm(3,nres+j)
949 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
951 C Calculate angle-dependent terms of energy and contributions to their
955 sig=sig0ij*dsqrt(sigsq)
956 rij_shift=1.0D0/rij-sig+r0ij
957 C I hate to put IF's in the loops, but here don't have another choice!!!!
958 if (rij_shift.le.0.0D0) then
963 c---------------------------------------------------------------
964 rij_shift=1.0D0/rij_shift
966 e1=fac*fac*aa(itypi,itypj)
967 e2=fac*bb(itypi,itypj)
968 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
969 eps2der=evdwij*eps3rt
970 eps3der=evdwij*eps2rt
972 e_augm=augm(itypi,itypj)*fac_augm
973 evdwij=evdwij*eps2rt*eps3rt
974 if (bb(itypi,itypj).gt.0.0d0) then
975 evdw=evdw+evdwij+e_augm
977 evdw_t=evdw_t+evdwij+e_augm
979 ij=icant(itypi,itypj)
980 aux=eps1*eps2rt**2*eps3rt**2
982 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
983 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
984 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
985 c & restyp(itypi),i,restyp(itypj),j,
986 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
987 c & chi1,chi2,chip1,chip2,
988 c & eps1,eps2rt**2,eps3rt**2,
989 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
993 C Calculate gradient components.
994 e1=e1*eps1*eps2rt**2*eps3rt**2
995 fac=-expon*(e1+evdwij)*rij_shift
997 fac=rij*fac-2*expon*rrij*e_augm
998 C Calculate the radial part of the gradient
1002 C Calculate angular part of the gradient.
1010 C-----------------------------------------------------------------------------
1011 subroutine sc_angular
1012 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1013 C om12. Called by ebp, egb, and egbv.
1015 include 'COMMON.CALC'
1019 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1020 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1021 om12=dxi*dxj+dyi*dyj+dzi*dzj
1023 C Calculate eps1(om12) and its derivative in om12
1024 faceps1=1.0D0-om12*chiom12
1025 faceps1_inv=1.0D0/faceps1
1026 eps1=dsqrt(faceps1_inv)
1027 C Following variable is eps1*deps1/dom12
1028 eps1_om12=faceps1_inv*chiom12
1029 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1034 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1035 sigsq=1.0D0-facsig*faceps1_inv
1036 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1037 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1038 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1039 C Calculate eps2 and its derivatives in om1, om2, and om12.
1042 chipom12=chip12*om12
1043 facp=1.0D0-om12*chipom12
1045 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1046 C Following variable is the square root of eps2
1047 eps2rt=1.0D0-facp1*facp_inv
1048 C Following three variables are the derivatives of the square root of eps
1049 C in om1, om2, and om12.
1050 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1051 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1052 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1053 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1054 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1055 C Calculate whole angle-dependent part of epsilon and contributions
1056 C to its derivatives
1059 C----------------------------------------------------------------------------
1061 implicit real*8 (a-h,o-z)
1062 include 'DIMENSIONS'
1063 include 'sizesclu.dat'
1064 include 'COMMON.CHAIN'
1065 include 'COMMON.DERIV'
1066 include 'COMMON.CALC'
1067 double precision dcosom1(3),dcosom2(3)
1068 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1069 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1070 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1071 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1073 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1074 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1077 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1080 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1081 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1082 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1083 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1084 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1085 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1088 C Calculate the components of the gradient in DC and X
1092 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1097 c------------------------------------------------------------------------------
1098 subroutine vec_and_deriv
1099 implicit real*8 (a-h,o-z)
1100 include 'DIMENSIONS'
1101 include 'sizesclu.dat'
1102 include 'COMMON.IOUNITS'
1103 include 'COMMON.GEO'
1104 include 'COMMON.VAR'
1105 include 'COMMON.LOCAL'
1106 include 'COMMON.CHAIN'
1107 include 'COMMON.VECTORS'
1108 include 'COMMON.DERIV'
1109 include 'COMMON.INTERACT'
1110 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1111 C Compute the local reference systems. For reference system (i), the
1112 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1113 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1115 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1116 if (i.eq.nres-1) then
1117 C Case of the last full residue
1118 C Compute the Z-axis
1119 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1120 costh=dcos(pi-theta(nres))
1121 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1126 C Compute the derivatives of uz
1128 uzder(2,1,1)=-dc_norm(3,i-1)
1129 uzder(3,1,1)= dc_norm(2,i-1)
1130 uzder(1,2,1)= dc_norm(3,i-1)
1132 uzder(3,2,1)=-dc_norm(1,i-1)
1133 uzder(1,3,1)=-dc_norm(2,i-1)
1134 uzder(2,3,1)= dc_norm(1,i-1)
1137 uzder(2,1,2)= dc_norm(3,i)
1138 uzder(3,1,2)=-dc_norm(2,i)
1139 uzder(1,2,2)=-dc_norm(3,i)
1141 uzder(3,2,2)= dc_norm(1,i)
1142 uzder(1,3,2)= dc_norm(2,i)
1143 uzder(2,3,2)=-dc_norm(1,i)
1146 C Compute the Y-axis
1149 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1152 C Compute the derivatives of uy
1155 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1156 & -dc_norm(k,i)*dc_norm(j,i-1)
1157 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1159 uyder(j,j,1)=uyder(j,j,1)-costh
1160 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1165 uygrad(l,k,j,i)=uyder(l,k,j)
1166 uzgrad(l,k,j,i)=uzder(l,k,j)
1170 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1171 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1172 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1173 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1177 C Compute the Z-axis
1178 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1179 costh=dcos(pi-theta(i+2))
1180 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1185 C Compute the derivatives of uz
1187 uzder(2,1,1)=-dc_norm(3,i+1)
1188 uzder(3,1,1)= dc_norm(2,i+1)
1189 uzder(1,2,1)= dc_norm(3,i+1)
1191 uzder(3,2,1)=-dc_norm(1,i+1)
1192 uzder(1,3,1)=-dc_norm(2,i+1)
1193 uzder(2,3,1)= dc_norm(1,i+1)
1196 uzder(2,1,2)= dc_norm(3,i)
1197 uzder(3,1,2)=-dc_norm(2,i)
1198 uzder(1,2,2)=-dc_norm(3,i)
1200 uzder(3,2,2)= dc_norm(1,i)
1201 uzder(1,3,2)= dc_norm(2,i)
1202 uzder(2,3,2)=-dc_norm(1,i)
1205 C Compute the Y-axis
1208 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1211 C Compute the derivatives of uy
1214 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1215 & -dc_norm(k,i)*dc_norm(j,i+1)
1216 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1218 uyder(j,j,1)=uyder(j,j,1)-costh
1219 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1224 uygrad(l,k,j,i)=uyder(l,k,j)
1225 uzgrad(l,k,j,i)=uzder(l,k,j)
1229 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1230 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1231 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1232 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1238 vbld_inv_temp(1)=vbld_inv(i+1)
1239 if (i.lt.nres-1) then
1240 vbld_inv_temp(2)=vbld_inv(i+2)
1242 vbld_inv_temp(2)=vbld_inv(i)
1247 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1248 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1256 C-----------------------------------------------------------------------------
1257 subroutine vec_and_deriv_test
1258 implicit real*8 (a-h,o-z)
1259 include 'DIMENSIONS'
1260 include 'sizesclu.dat'
1261 include 'COMMON.IOUNITS'
1262 include 'COMMON.GEO'
1263 include 'COMMON.VAR'
1264 include 'COMMON.LOCAL'
1265 include 'COMMON.CHAIN'
1266 include 'COMMON.VECTORS'
1267 dimension uyder(3,3,2),uzder(3,3,2)
1268 C Compute the local reference systems. For reference system (i), the
1269 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1270 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1272 if (i.eq.nres-1) then
1273 C Case of the last full residue
1274 C Compute the Z-axis
1275 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1276 costh=dcos(pi-theta(nres))
1277 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1278 c write (iout,*) 'fac',fac,
1279 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1280 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1284 C Compute the derivatives of uz
1286 uzder(2,1,1)=-dc_norm(3,i-1)
1287 uzder(3,1,1)= dc_norm(2,i-1)
1288 uzder(1,2,1)= dc_norm(3,i-1)
1290 uzder(3,2,1)=-dc_norm(1,i-1)
1291 uzder(1,3,1)=-dc_norm(2,i-1)
1292 uzder(2,3,1)= dc_norm(1,i-1)
1295 uzder(2,1,2)= dc_norm(3,i)
1296 uzder(3,1,2)=-dc_norm(2,i)
1297 uzder(1,2,2)=-dc_norm(3,i)
1299 uzder(3,2,2)= dc_norm(1,i)
1300 uzder(1,3,2)= dc_norm(2,i)
1301 uzder(2,3,2)=-dc_norm(1,i)
1303 C Compute the Y-axis
1305 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1308 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1309 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1310 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1312 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1315 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1316 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1319 c write (iout,*) 'facy',facy,
1320 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1321 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1323 uy(k,i)=facy*uy(k,i)
1325 C Compute the derivatives of uy
1328 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1329 & -dc_norm(k,i)*dc_norm(j,i-1)
1330 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1332 c uyder(j,j,1)=uyder(j,j,1)-costh
1333 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1334 uyder(j,j,1)=uyder(j,j,1)
1335 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1336 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1342 uygrad(l,k,j,i)=uyder(l,k,j)
1343 uzgrad(l,k,j,i)=uzder(l,k,j)
1347 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1348 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1349 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1350 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1353 C Compute the Z-axis
1354 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1355 costh=dcos(pi-theta(i+2))
1356 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1357 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1361 C Compute the derivatives of uz
1363 uzder(2,1,1)=-dc_norm(3,i+1)
1364 uzder(3,1,1)= dc_norm(2,i+1)
1365 uzder(1,2,1)= dc_norm(3,i+1)
1367 uzder(3,2,1)=-dc_norm(1,i+1)
1368 uzder(1,3,1)=-dc_norm(2,i+1)
1369 uzder(2,3,1)= dc_norm(1,i+1)
1372 uzder(2,1,2)= dc_norm(3,i)
1373 uzder(3,1,2)=-dc_norm(2,i)
1374 uzder(1,2,2)=-dc_norm(3,i)
1376 uzder(3,2,2)= dc_norm(1,i)
1377 uzder(1,3,2)= dc_norm(2,i)
1378 uzder(2,3,2)=-dc_norm(1,i)
1380 C Compute the Y-axis
1382 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1383 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1384 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1386 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1389 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1390 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1393 c write (iout,*) 'facy',facy,
1394 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1395 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1397 uy(k,i)=facy*uy(k,i)
1399 C Compute the derivatives of uy
1402 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1403 & -dc_norm(k,i)*dc_norm(j,i+1)
1404 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1406 c uyder(j,j,1)=uyder(j,j,1)-costh
1407 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1408 uyder(j,j,1)=uyder(j,j,1)
1409 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1410 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1416 uygrad(l,k,j,i)=uyder(l,k,j)
1417 uzgrad(l,k,j,i)=uzder(l,k,j)
1421 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1422 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1423 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1424 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1431 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1432 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1439 C-----------------------------------------------------------------------------
1440 subroutine check_vecgrad
1441 implicit real*8 (a-h,o-z)
1442 include 'DIMENSIONS'
1443 include 'sizesclu.dat'
1444 include 'COMMON.IOUNITS'
1445 include 'COMMON.GEO'
1446 include 'COMMON.VAR'
1447 include 'COMMON.LOCAL'
1448 include 'COMMON.CHAIN'
1449 include 'COMMON.VECTORS'
1450 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1451 dimension uyt(3,maxres),uzt(3,maxres)
1452 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1453 double precision delta /1.0d-7/
1456 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1457 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1458 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1459 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1460 cd & (dc_norm(if90,i),if90=1,3)
1461 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1462 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1463 cd write(iout,'(a)')
1469 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1470 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1483 cd write (iout,*) 'i=',i
1485 erij(k)=dc_norm(k,i)
1489 dc_norm(k,i)=erij(k)
1491 dc_norm(j,i)=dc_norm(j,i)+delta
1492 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1494 c dc_norm(k,i)=dc_norm(k,i)/fac
1496 c write (iout,*) (dc_norm(k,i),k=1,3)
1497 c write (iout,*) (erij(k),k=1,3)
1500 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1501 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1502 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1503 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1505 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1506 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1507 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1510 dc_norm(k,i)=erij(k)
1513 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1514 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1515 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1516 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1517 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1518 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1519 cd write (iout,'(a)')
1524 C--------------------------------------------------------------------------
1525 subroutine set_matrices
1526 implicit real*8 (a-h,o-z)
1527 include 'DIMENSIONS'
1528 include 'sizesclu.dat'
1529 include 'COMMON.IOUNITS'
1530 include 'COMMON.GEO'
1531 include 'COMMON.VAR'
1532 include 'COMMON.LOCAL'
1533 include 'COMMON.CHAIN'
1534 include 'COMMON.DERIV'
1535 include 'COMMON.INTERACT'
1536 include 'COMMON.CONTACTS'
1537 include 'COMMON.TORSION'
1538 include 'COMMON.VECTORS'
1539 include 'COMMON.FFIELD'
1540 double precision auxvec(2),auxmat(2,2)
1542 C Compute the virtual-bond-torsional-angle dependent quantities needed
1543 C to calculate the el-loc multibody terms of various order.
1546 if (i .lt. nres+1) then
1583 if (i .gt. 3 .and. i .lt. nres+1) then
1584 obrot_der(1,i-2)=-sin1
1585 obrot_der(2,i-2)= cos1
1586 Ugder(1,1,i-2)= sin1
1587 Ugder(1,2,i-2)=-cos1
1588 Ugder(2,1,i-2)=-cos1
1589 Ugder(2,2,i-2)=-sin1
1592 obrot2_der(1,i-2)=-dwasin2
1593 obrot2_der(2,i-2)= dwacos2
1594 Ug2der(1,1,i-2)= dwasin2
1595 Ug2der(1,2,i-2)=-dwacos2
1596 Ug2der(2,1,i-2)=-dwacos2
1597 Ug2der(2,2,i-2)=-dwasin2
1599 obrot_der(1,i-2)=0.0d0
1600 obrot_der(2,i-2)=0.0d0
1601 Ugder(1,1,i-2)=0.0d0
1602 Ugder(1,2,i-2)=0.0d0
1603 Ugder(2,1,i-2)=0.0d0
1604 Ugder(2,2,i-2)=0.0d0
1605 obrot2_der(1,i-2)=0.0d0
1606 obrot2_der(2,i-2)=0.0d0
1607 Ug2der(1,1,i-2)=0.0d0
1608 Ug2der(1,2,i-2)=0.0d0
1609 Ug2der(2,1,i-2)=0.0d0
1610 Ug2der(2,2,i-2)=0.0d0
1612 if (i.gt. nnt+2 .and. i.lt.nct+2) then
1613 if (itype(i-2).le.ntyp) then
1614 iti = itortyp(itype(i-2))
1621 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1622 if (itype(i-1).le.ntyp) then
1623 iti1 = itortyp(itype(i-1))
1630 cd write (iout,*) '*******i',i,' iti1',iti
1631 cd write (iout,*) 'b1',b1(:,iti)
1632 cd write (iout,*) 'b2',b2(:,iti)
1633 cd write (iout,*) 'Ug',Ug(:,:,i-2)
1634 c print *,"itilde1 i iti iti1",i,iti,iti1
1635 if (i .gt. iatel_s+2) then
1636 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
1637 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
1638 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
1639 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
1640 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
1641 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
1642 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
1652 DtUg2(l,k,i-2)=0.0d0
1656 c print *,"itilde2 i iti iti1",i,iti,iti1
1657 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
1658 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
1659 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
1660 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
1661 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
1662 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
1663 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
1664 c print *,"itilde3 i iti iti1",i,iti,iti1
1666 muder(k,i-2)=Ub2der(k,i-2)
1668 if (i.gt. nnt+1 .and. i.lt.nct+1) then
1669 if (itype(i-1).le.ntyp) then
1670 iti1 = itortyp(itype(i-1))
1678 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
1680 C Vectors and matrices dependent on a single virtual-bond dihedral.
1681 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
1682 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
1683 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
1684 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
1685 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
1686 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
1687 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
1688 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
1689 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
1690 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
1691 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
1693 C Matrices dependent on two consecutive virtual-bond dihedrals.
1694 C The order of matrices is from left to right.
1696 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
1697 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
1698 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
1699 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
1700 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
1701 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
1702 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
1703 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
1706 cd iti = itortyp(itype(i))
1709 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
1710 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
1715 C--------------------------------------------------------------------------
1716 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1718 C This subroutine calculates the average interaction energy and its gradient
1719 C in the virtual-bond vectors between non-adjacent peptide groups, based on
1720 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
1721 C The potential depends both on the distance of peptide-group centers and on
1722 C the orientation of the CA-CA virtual bonds.
1724 implicit real*8 (a-h,o-z)
1725 include 'DIMENSIONS'
1726 include 'sizesclu.dat'
1727 include 'COMMON.CONTROL'
1728 include 'COMMON.IOUNITS'
1729 include 'COMMON.GEO'
1730 include 'COMMON.VAR'
1731 include 'COMMON.LOCAL'
1732 include 'COMMON.CHAIN'
1733 include 'COMMON.DERIV'
1734 include 'COMMON.INTERACT'
1735 include 'COMMON.CONTACTS'
1736 include 'COMMON.TORSION'
1737 include 'COMMON.VECTORS'
1738 include 'COMMON.FFIELD'
1739 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
1740 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
1741 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
1742 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
1743 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
1744 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
1745 double precision scal_el /0.5d0/
1747 C 13-go grudnia roku pamietnego...
1748 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
1749 & 0.0d0,1.0d0,0.0d0,
1750 & 0.0d0,0.0d0,1.0d0/
1751 cd write(iout,*) 'In EELEC'
1753 cd write(iout,*) 'Type',i
1754 cd write(iout,*) 'B1',B1(:,i)
1755 cd write(iout,*) 'B2',B2(:,i)
1756 cd write(iout,*) 'CC',CC(:,:,i)
1757 cd write(iout,*) 'DD',DD(:,:,i)
1758 cd write(iout,*) 'EE',EE(:,:,i)
1760 cd call check_vecgrad
1762 if (icheckgrad.eq.1) then
1764 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
1766 dc_norm(k,i)=dc(k,i)*fac
1768 c write (iout,*) 'i',i,' fac',fac
1771 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1772 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
1773 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
1774 cd if (wel_loc.gt.0.0d0) then
1775 if (icheckgrad.eq.1) then
1776 call vec_and_deriv_test
1783 cd write (iout,*) 'i=',i
1785 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
1788 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
1789 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
1802 cd print '(a)','Enter EELEC'
1803 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
1805 gel_loc_loc(i)=0.0d0
1808 do i=iatel_s,iatel_e
1809 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
1810 if (itel(i).eq.0) goto 1215
1814 dx_normi=dc_norm(1,i)
1815 dy_normi=dc_norm(2,i)
1816 dz_normi=dc_norm(3,i)
1817 xmedi=c(1,i)+0.5d0*dxi
1818 ymedi=c(2,i)+0.5d0*dyi
1819 zmedi=c(3,i)+0.5d0*dzi
1821 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1822 do j=ielstart(i),ielend(i)
1823 if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
1824 if (itel(j).eq.0) goto 1216
1828 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1829 aaa=app(iteli,itelj)
1830 bbb=bpp(iteli,itelj)
1831 C Diagnostics only!!!
1837 ael6i=ael6(iteli,itelj)
1838 ael3i=ael3(iteli,itelj)
1842 dx_normj=dc_norm(1,j)
1843 dy_normj=dc_norm(2,j)
1844 dz_normj=dc_norm(3,j)
1845 xj=c(1,j)+0.5D0*dxj-xmedi
1846 yj=c(2,j)+0.5D0*dyj-ymedi
1847 zj=c(3,j)+0.5D0*dzj-zmedi
1848 rij=xj*xj+yj*yj+zj*zj
1854 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
1855 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
1856 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
1857 fac=cosa-3.0D0*cosb*cosg
1859 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
1860 if (j.eq.i+2) ev1=scal_el*ev1
1865 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
1868 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
1869 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
1870 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
1873 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
1874 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
1875 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
1876 cd & xmedi,ymedi,zmedi,xj,yj,zj
1878 C Calculate contributions to the Cartesian gradient.
1881 facvdw=-6*rrmij*(ev1+evdwij)
1882 facel=-3*rrmij*(el1+eesij)
1889 * Radial derivatives. First process both termini of the fragment (i,j)
1896 gelc(k,i)=gelc(k,i)+ghalf
1897 gelc(k,j)=gelc(k,j)+ghalf
1900 * Loop over residues i+1 thru j-1.
1904 gelc(l,k)=gelc(l,k)+ggg(l)
1912 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
1913 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
1916 * Loop over residues i+1 thru j-1.
1920 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
1927 fac=-3*rrmij*(facvdw+facvdw+facel)
1933 * Radial derivatives. First process both termini of the fragment (i,j)
1940 gelc(k,i)=gelc(k,i)+ghalf
1941 gelc(k,j)=gelc(k,j)+ghalf
1944 * Loop over residues i+1 thru j-1.
1948 gelc(l,k)=gelc(l,k)+ggg(l)
1955 ecosa=2.0D0*fac3*fac1+fac4
1958 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
1959 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
1961 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
1962 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
1964 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
1965 cd & (dcosg(k),k=1,3)
1967 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
1971 gelc(k,i)=gelc(k,i)+ghalf
1972 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
1973 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
1974 gelc(k,j)=gelc(k,j)+ghalf
1975 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
1976 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
1980 gelc(l,k)=gelc(l,k)+ggg(l)
1985 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
1986 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
1987 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
1989 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
1990 C energy of a peptide unit is assumed in the form of a second-order
1991 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
1992 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
1993 C are computed for EVERY pair of non-contiguous peptide groups.
1995 if (j.lt.nres-1) then
2006 muij(kkk)=mu(k,i)*mu(l,j)
2009 cd write (iout,*) 'EELEC: i',i,' j',j
2010 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2011 cd write(iout,*) 'muij',muij
2012 ury=scalar(uy(1,i),erij)
2013 urz=scalar(uz(1,i),erij)
2014 vry=scalar(uy(1,j),erij)
2015 vrz=scalar(uz(1,j),erij)
2016 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2017 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2018 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2019 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2020 C For diagnostics only
2025 fac=dsqrt(-ael6i)*r3ij
2026 cd write (2,*) 'fac=',fac
2027 C For diagnostics only
2033 cd write (iout,'(4i5,4f10.5)')
2034 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2035 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2036 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2037 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2038 cd write (iout,'(4f10.5)')
2039 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2040 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2041 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2042 cd write (iout,'(2i3,9f10.5/)') i,j,
2043 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2045 C Derivatives of the elements of A in virtual-bond vectors
2046 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2053 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2054 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2055 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2056 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2057 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2058 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2059 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2060 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2061 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2062 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2063 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2064 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2074 C Compute radial contributions to the gradient
2096 C Add the contributions coming from er
2099 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2100 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2101 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2102 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2105 C Derivatives in DC(i)
2106 ghalf1=0.5d0*agg(k,1)
2107 ghalf2=0.5d0*agg(k,2)
2108 ghalf3=0.5d0*agg(k,3)
2109 ghalf4=0.5d0*agg(k,4)
2110 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2111 & -3.0d0*uryg(k,2)*vry)+ghalf1
2112 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2113 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2114 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2115 & -3.0d0*urzg(k,2)*vry)+ghalf3
2116 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2117 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2118 C Derivatives in DC(i+1)
2119 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2120 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2121 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2122 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2123 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2124 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2125 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2126 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2127 C Derivatives in DC(j)
2128 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2129 & -3.0d0*vryg(k,2)*ury)+ghalf1
2130 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2131 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2132 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2133 & -3.0d0*vryg(k,2)*urz)+ghalf3
2134 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2135 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2136 C Derivatives in DC(j+1) or DC(nres-1)
2137 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2138 & -3.0d0*vryg(k,3)*ury)
2139 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2140 & -3.0d0*vrzg(k,3)*ury)
2141 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2142 & -3.0d0*vryg(k,3)*urz)
2143 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2144 & -3.0d0*vrzg(k,3)*urz)
2149 C Derivatives in DC(i+1)
2150 cd aggi1(k,1)=agg(k,1)
2151 cd aggi1(k,2)=agg(k,2)
2152 cd aggi1(k,3)=agg(k,3)
2153 cd aggi1(k,4)=agg(k,4)
2154 C Derivatives in DC(j)
2159 C Derivatives in DC(j+1)
2164 if (j.eq.nres-1 .and. i.lt.j-2) then
2166 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2167 cd aggj1(k,l)=agg(k,l)
2173 C Check the loc-el terms by numerical integration
2183 aggi(k,l)=-aggi(k,l)
2184 aggi1(k,l)=-aggi1(k,l)
2185 aggj(k,l)=-aggj(k,l)
2186 aggj1(k,l)=-aggj1(k,l)
2189 if (j.lt.nres-1) then
2195 aggi(k,l)=-aggi(k,l)
2196 aggi1(k,l)=-aggi1(k,l)
2197 aggj(k,l)=-aggj(k,l)
2198 aggj1(k,l)=-aggj1(k,l)
2209 aggi(k,l)=-aggi(k,l)
2210 aggi1(k,l)=-aggi1(k,l)
2211 aggj(k,l)=-aggj(k,l)
2212 aggj1(k,l)=-aggj1(k,l)
2218 IF (wel_loc.gt.0.0d0) THEN
2219 C Contribution to the local-electrostatic energy coming from the i-j pair
2220 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2222 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
2223 cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2224 eel_loc=eel_loc+eel_loc_ij
2225 C Partial derivatives in virtual-bond dihedral angles gamma
2228 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2229 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2230 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
2231 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2232 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2233 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
2234 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2235 cd write(iout,*) 'agg ',agg
2236 cd write(iout,*) 'aggi ',aggi
2237 cd write(iout,*) 'aggi1',aggi1
2238 cd write(iout,*) 'aggj ',aggj
2239 cd write(iout,*) 'aggj1',aggj1
2241 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2243 ggg(l)=agg(l,1)*muij(1)+
2244 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
2248 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2251 C Remaining derivatives of eello
2253 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
2254 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
2255 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
2256 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
2257 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
2258 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
2259 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
2260 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
2264 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2265 C Contributions from turns
2270 call eturn34(i,j,eello_turn3,eello_turn4)
2272 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2273 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2275 C Calculate the contact function. The ith column of the array JCONT will
2276 C contain the numbers of atoms that make contacts with the atom I (of numbers
2277 C greater than I). The arrays FACONT and GACONT will contain the values of
2278 C the contact function and its derivative.
2279 c r0ij=1.02D0*rpp(iteli,itelj)
2280 c r0ij=1.11D0*rpp(iteli,itelj)
2281 r0ij=2.20D0*rpp(iteli,itelj)
2282 c r0ij=1.55D0*rpp(iteli,itelj)
2283 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2284 if (fcont.gt.0.0D0) then
2285 num_conti=num_conti+1
2286 if (num_conti.gt.maxconts) then
2287 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2288 & ' will skip next contacts for this conf.'
2290 jcont_hb(num_conti,i)=j
2291 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
2292 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2293 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
2295 d_cont(num_conti,i)=rij
2296 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
2297 C --- Electrostatic-interaction matrix ---
2298 a_chuj(1,1,num_conti,i)=a22
2299 a_chuj(1,2,num_conti,i)=a23
2300 a_chuj(2,1,num_conti,i)=a32
2301 a_chuj(2,2,num_conti,i)=a33
2302 C --- Gradient of rij
2304 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
2307 c a_chuj(1,1,num_conti,i)=-0.61d0
2308 c a_chuj(1,2,num_conti,i)= 0.4d0
2309 c a_chuj(2,1,num_conti,i)= 0.65d0
2310 c a_chuj(2,2,num_conti,i)= 0.50d0
2311 c else if (i.eq.2) then
2312 c a_chuj(1,1,num_conti,i)= 0.0d0
2313 c a_chuj(1,2,num_conti,i)= 0.0d0
2314 c a_chuj(2,1,num_conti,i)= 0.0d0
2315 c a_chuj(2,2,num_conti,i)= 0.0d0
2317 C --- and its gradients
2318 cd write (iout,*) 'i',i,' j',j
2320 cd write (iout,*) 'iii 1 kkk',kkk
2321 cd write (iout,*) agg(kkk,:)
2324 cd write (iout,*) 'iii 2 kkk',kkk
2325 cd write (iout,*) aggi(kkk,:)
2328 cd write (iout,*) 'iii 3 kkk',kkk
2329 cd write (iout,*) aggi1(kkk,:)
2332 cd write (iout,*) 'iii 4 kkk',kkk
2333 cd write (iout,*) aggj(kkk,:)
2336 cd write (iout,*) 'iii 5 kkk',kkk
2337 cd write (iout,*) aggj1(kkk,:)
2344 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
2345 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
2346 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
2347 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
2348 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
2350 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
2356 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
2357 C Calculate contact energies
2359 wij=cosa-3.0D0*cosb*cosg
2362 c fac3=dsqrt(-ael6i)/r0ij**3
2363 fac3=dsqrt(-ael6i)*r3ij
2364 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
2365 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
2367 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
2368 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
2369 C Diagnostics. Comment out or remove after debugging!
2370 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
2371 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
2372 c ees0m(num_conti,i)=0.0D0
2374 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
2375 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
2376 facont_hb(num_conti,i)=fcont
2378 C Angular derivatives of the contact function
2379 ees0pij1=fac3/ees0pij
2380 ees0mij1=fac3/ees0mij
2381 fac3p=-3.0D0*fac3*rrmij
2382 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
2383 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
2385 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
2386 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
2387 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
2388 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
2389 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
2390 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
2391 ecosap=ecosa1+ecosa2
2392 ecosbp=ecosb1+ecosb2
2393 ecosgp=ecosg1+ecosg2
2394 ecosam=ecosa1-ecosa2
2395 ecosbm=ecosb1-ecosb2
2396 ecosgm=ecosg1-ecosg2
2405 fprimcont=fprimcont/rij
2406 cd facont_hb(num_conti,i)=1.0D0
2407 C Following line is for diagnostics.
2410 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2411 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2414 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
2415 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
2417 gggp(1)=gggp(1)+ees0pijp*xj
2418 gggp(2)=gggp(2)+ees0pijp*yj
2419 gggp(3)=gggp(3)+ees0pijp*zj
2420 gggm(1)=gggm(1)+ees0mijp*xj
2421 gggm(2)=gggm(2)+ees0mijp*yj
2422 gggm(3)=gggm(3)+ees0mijp*zj
2423 C Derivatives due to the contact function
2424 gacont_hbr(1,num_conti,i)=fprimcont*xj
2425 gacont_hbr(2,num_conti,i)=fprimcont*yj
2426 gacont_hbr(3,num_conti,i)=fprimcont*zj
2428 ghalfp=0.5D0*gggp(k)
2429 ghalfm=0.5D0*gggm(k)
2430 gacontp_hb1(k,num_conti,i)=ghalfp
2431 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
2432 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2433 gacontp_hb2(k,num_conti,i)=ghalfp
2434 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
2435 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2436 gacontp_hb3(k,num_conti,i)=gggp(k)
2437 gacontm_hb1(k,num_conti,i)=ghalfm
2438 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
2439 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2440 gacontm_hb2(k,num_conti,i)=ghalfm
2441 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
2442 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2443 gacontm_hb3(k,num_conti,i)=gggm(k)
2446 C Diagnostics. Comment out or remove after debugging!
2448 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
2449 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
2450 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
2451 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
2452 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
2453 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
2456 endif ! num_conti.le.maxconts
2461 num_cont_hb(i)=num_conti
2465 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2466 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2468 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2469 ccc eel_loc=eel_loc+eello_turn3
2472 C-----------------------------------------------------------------------------
2473 subroutine eturn34(i,j,eello_turn3,eello_turn4)
2474 C Third- and fourth-order contributions from turns
2475 implicit real*8 (a-h,o-z)
2476 include 'DIMENSIONS'
2477 include 'sizesclu.dat'
2478 include 'COMMON.IOUNITS'
2479 include 'COMMON.GEO'
2480 include 'COMMON.VAR'
2481 include 'COMMON.LOCAL'
2482 include 'COMMON.CHAIN'
2483 include 'COMMON.DERIV'
2484 include 'COMMON.INTERACT'
2485 include 'COMMON.CONTACTS'
2486 include 'COMMON.TORSION'
2487 include 'COMMON.VECTORS'
2488 include 'COMMON.FFIELD'
2490 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2491 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2492 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2493 double precision agg(3,4),aggi(3,4),aggi1(3,4),
2494 & aggj(3,4),aggj1(3,4),a_temp(2,2)
2495 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2497 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2499 C Third-order contributions
2506 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2507 cd call checkint_turn3(i,a_temp,eello_turn3_num)
2508 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2509 call transpose2(auxmat(1,1),auxmat1(1,1))
2510 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2511 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2512 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
2513 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
2514 cd & ' eello_turn3_num',4*eello_turn3_num
2516 C Derivatives in gamma(i)
2517 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2518 call transpose2(auxmat2(1,1),pizda(1,1))
2519 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2520 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2521 C Derivatives in gamma(i+1)
2522 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2523 call transpose2(auxmat2(1,1),pizda(1,1))
2524 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
2525 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2526 & +0.5d0*(pizda(1,1)+pizda(2,2))
2527 C Cartesian derivatives
2529 a_temp(1,1)=aggi(l,1)
2530 a_temp(1,2)=aggi(l,2)
2531 a_temp(2,1)=aggi(l,3)
2532 a_temp(2,2)=aggi(l,4)
2533 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2534 gcorr3_turn(l,i)=gcorr3_turn(l,i)
2535 & +0.5d0*(pizda(1,1)+pizda(2,2))
2536 a_temp(1,1)=aggi1(l,1)
2537 a_temp(1,2)=aggi1(l,2)
2538 a_temp(2,1)=aggi1(l,3)
2539 a_temp(2,2)=aggi1(l,4)
2540 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2541 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2542 & +0.5d0*(pizda(1,1)+pizda(2,2))
2543 a_temp(1,1)=aggj(l,1)
2544 a_temp(1,2)=aggj(l,2)
2545 a_temp(2,1)=aggj(l,3)
2546 a_temp(2,2)=aggj(l,4)
2547 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2548 gcorr3_turn(l,j)=gcorr3_turn(l,j)
2549 & +0.5d0*(pizda(1,1)+pizda(2,2))
2550 a_temp(1,1)=aggj1(l,1)
2551 a_temp(1,2)=aggj1(l,2)
2552 a_temp(2,1)=aggj1(l,3)
2553 a_temp(2,2)=aggj1(l,4)
2554 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2555 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
2556 & +0.5d0*(pizda(1,1)+pizda(2,2))
2559 else if (j.eq.i+3 .and. itype(i+2).ne.21) then
2560 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2562 C Fourth-order contributions
2570 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2571 cd call checkint_turn4(i,a_temp,eello_turn4_num)
2572 iti1=itortyp(itype(i+1))
2573 iti2=itortyp(itype(i+2))
2574 iti3=itortyp(itype(i+3))
2575 call transpose2(EUg(1,1,i+1),e1t(1,1))
2576 call transpose2(Eug(1,1,i+2),e2t(1,1))
2577 call transpose2(Eug(1,1,i+3),e3t(1,1))
2578 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2579 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2580 s1=scalar2(b1(1,iti2),auxvec(1))
2581 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2582 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2583 s2=scalar2(b1(1,iti1),auxvec(1))
2584 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2585 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2586 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2587 eello_turn4=eello_turn4-(s1+s2+s3)
2588 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
2589 cd & ' eello_turn4_num',8*eello_turn4_num
2590 C Derivatives in gamma(i)
2592 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
2593 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
2594 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
2595 s1=scalar2(b1(1,iti2),auxvec(1))
2596 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
2597 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2598 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
2599 C Derivatives in gamma(i+1)
2600 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
2601 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
2602 s2=scalar2(b1(1,iti1),auxvec(1))
2603 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
2604 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2605 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2606 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
2607 C Derivatives in gamma(i+2)
2608 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
2609 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
2610 s1=scalar2(b1(1,iti2),auxvec(1))
2611 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
2612 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
2613 s2=scalar2(b1(1,iti1),auxvec(1))
2614 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
2615 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
2616 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2617 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
2618 C Cartesian derivatives
2619 C Derivatives of this turn contributions in DC(i+2)
2620 if (j.lt.nres-1) then
2622 a_temp(1,1)=agg(l,1)
2623 a_temp(1,2)=agg(l,2)
2624 a_temp(2,1)=agg(l,3)
2625 a_temp(2,2)=agg(l,4)
2626 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2627 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2628 s1=scalar2(b1(1,iti2),auxvec(1))
2629 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2630 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2631 s2=scalar2(b1(1,iti1),auxvec(1))
2632 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2633 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2634 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2636 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
2639 C Remaining derivatives of this turn contribution
2641 a_temp(1,1)=aggi(l,1)
2642 a_temp(1,2)=aggi(l,2)
2643 a_temp(2,1)=aggi(l,3)
2644 a_temp(2,2)=aggi(l,4)
2645 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2646 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2647 s1=scalar2(b1(1,iti2),auxvec(1))
2648 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2649 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2650 s2=scalar2(b1(1,iti1),auxvec(1))
2651 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2652 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2653 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2654 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
2655 a_temp(1,1)=aggi1(l,1)
2656 a_temp(1,2)=aggi1(l,2)
2657 a_temp(2,1)=aggi1(l,3)
2658 a_temp(2,2)=aggi1(l,4)
2659 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2660 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2661 s1=scalar2(b1(1,iti2),auxvec(1))
2662 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2663 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2664 s2=scalar2(b1(1,iti1),auxvec(1))
2665 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2666 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2667 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2668 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
2669 a_temp(1,1)=aggj(l,1)
2670 a_temp(1,2)=aggj(l,2)
2671 a_temp(2,1)=aggj(l,3)
2672 a_temp(2,2)=aggj(l,4)
2673 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2674 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2675 s1=scalar2(b1(1,iti2),auxvec(1))
2676 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2677 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2678 s2=scalar2(b1(1,iti1),auxvec(1))
2679 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2680 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2681 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2682 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
2683 a_temp(1,1)=aggj1(l,1)
2684 a_temp(1,2)=aggj1(l,2)
2685 a_temp(2,1)=aggj1(l,3)
2686 a_temp(2,2)=aggj1(l,4)
2687 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
2688 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
2689 s1=scalar2(b1(1,iti2),auxvec(1))
2690 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
2691 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
2692 s2=scalar2(b1(1,iti1),auxvec(1))
2693 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
2694 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
2695 s3=0.5d0*(pizda(1,1)+pizda(2,2))
2696 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
2702 C-----------------------------------------------------------------------------
2703 subroutine vecpr(u,v,w)
2704 implicit real*8(a-h,o-z)
2705 dimension u(3),v(3),w(3)
2706 w(1)=u(2)*v(3)-u(3)*v(2)
2707 w(2)=-u(1)*v(3)+u(3)*v(1)
2708 w(3)=u(1)*v(2)-u(2)*v(1)
2711 C-----------------------------------------------------------------------------
2712 subroutine unormderiv(u,ugrad,unorm,ungrad)
2713 C This subroutine computes the derivatives of a normalized vector u, given
2714 C the derivatives computed without normalization conditions, ugrad. Returns
2717 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
2718 double precision vec(3)
2719 double precision scalar
2721 c write (2,*) 'ugrad',ugrad
2724 vec(i)=scalar(ugrad(1,i),u(1))
2726 c write (2,*) 'vec',vec
2729 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
2732 c write (2,*) 'ungrad',ungrad
2735 C-----------------------------------------------------------------------------
2736 subroutine escp(evdw2,evdw2_14)
2738 C This subroutine calculates the excluded-volume interaction energy between
2739 C peptide-group centers and side chains and its gradient in virtual-bond and
2740 C side-chain vectors.
2742 implicit real*8 (a-h,o-z)
2743 include 'DIMENSIONS'
2744 include 'sizesclu.dat'
2745 include 'COMMON.GEO'
2746 include 'COMMON.VAR'
2747 include 'COMMON.LOCAL'
2748 include 'COMMON.CHAIN'
2749 include 'COMMON.DERIV'
2750 include 'COMMON.INTERACT'
2751 include 'COMMON.FFIELD'
2752 include 'COMMON.IOUNITS'
2756 cd print '(a)','Enter ESCP'
2757 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
2758 c & ' scal14',scal14
2759 do i=iatscp_s,iatscp_e
2760 if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
2762 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
2763 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
2764 if (iteli.eq.0) goto 1225
2765 xi=0.5D0*(c(1,i)+c(1,i+1))
2766 yi=0.5D0*(c(2,i)+c(2,i+1))
2767 zi=0.5D0*(c(3,i)+c(3,i+1))
2769 do iint=1,nscp_gr(i)
2771 do j=iscpstart(i,iint),iscpend(i,iint)
2773 if (itypj.eq.21) cycle
2774 C Uncomment following three lines for SC-p interactions
2778 C Uncomment following three lines for Ca-p interactions
2782 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2784 e1=fac*fac*aad(itypj,iteli)
2785 e2=fac*bad(itypj,iteli)
2786 if (iabs(j-i) .le. 2) then
2789 evdw2_14=evdw2_14+e1+e2
2792 c write (iout,*) i,j,evdwij
2796 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
2798 fac=-(evdwij+e1)*rrij
2803 cd write (iout,*) 'j<i'
2804 C Uncomment following three lines for SC-p interactions
2806 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
2809 cd write (iout,*) 'j>i'
2812 C Uncomment following line for SC-p interactions
2813 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
2817 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
2821 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
2822 cd write (iout,*) ggg(1),ggg(2),ggg(3)
2825 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
2835 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
2836 gradx_scp(j,i)=expon*gradx_scp(j,i)
2839 C******************************************************************************
2843 C To save time the factor EXPON has been extracted from ALL components
2844 C of GVDWC and GRADX. Remember to multiply them by this factor before further
2847 C******************************************************************************
2850 C--------------------------------------------------------------------------
2851 subroutine edis(ehpb)
2853 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
2855 implicit real*8 (a-h,o-z)
2856 include 'DIMENSIONS'
2857 include 'sizesclu.dat'
2858 include 'COMMON.SBRIDGE'
2859 include 'COMMON.CHAIN'
2860 include 'COMMON.DERIV'
2861 include 'COMMON.VAR'
2862 include 'COMMON.INTERACT'
2865 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
2866 cd print *,'link_start=',link_start,' link_end=',link_end
2867 if (link_end.eq.0) return
2868 do i=link_start,link_end
2869 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
2870 C CA-CA distance used in regularization of structure.
2873 C iii and jjj point to the residues for which the distance is assigned.
2874 if (ii.gt.nres) then
2881 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
2882 C distance and angle dependent SS bond potential.
2883 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
2884 call ssbond_ene(iii,jjj,eij)
2887 C Calculate the distance between the two points and its difference from the
2891 C Get the force constant corresponding to this distance.
2893 C Calculate the contribution to energy.
2894 ehpb=ehpb+waga*rdis*rdis
2896 C Evaluate gradient.
2899 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
2900 cd & ' waga=',waga,' fac=',fac
2902 ggg(j)=fac*(c(j,jj)-c(j,ii))
2904 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
2905 C If this is a SC-SC distance, we need to calculate the contributions to the
2906 C Cartesian gradient in the SC vectors (ghpbx).
2909 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
2910 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
2915 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
2923 C--------------------------------------------------------------------------
2924 subroutine ssbond_ene(i,j,eij)
2926 C Calculate the distance and angle dependent SS-bond potential energy
2927 C using a free-energy function derived based on RHF/6-31G** ab initio
2928 C calculations of diethyl disulfide.
2930 C A. Liwo and U. Kozlowska, 11/24/03
2932 implicit real*8 (a-h,o-z)
2933 include 'DIMENSIONS'
2934 include 'sizesclu.dat'
2935 include 'COMMON.SBRIDGE'
2936 include 'COMMON.CHAIN'
2937 include 'COMMON.DERIV'
2938 include 'COMMON.LOCAL'
2939 include 'COMMON.INTERACT'
2940 include 'COMMON.VAR'
2941 include 'COMMON.IOUNITS'
2942 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
2947 dxi=dc_norm(1,nres+i)
2948 dyi=dc_norm(2,nres+i)
2949 dzi=dc_norm(3,nres+i)
2950 dsci_inv=dsc_inv(itypi)
2952 dscj_inv=dsc_inv(itypj)
2956 dxj=dc_norm(1,nres+j)
2957 dyj=dc_norm(2,nres+j)
2958 dzj=dc_norm(3,nres+j)
2959 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2964 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2965 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2966 om12=dxi*dxj+dyi*dyj+dzi*dzj
2968 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2969 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2975 deltat12=om2-om1+2.0d0
2977 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
2978 & +akct*deltad*deltat12
2979 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
2980 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
2981 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
2982 c & " deltat12",deltat12," eij",eij
2983 ed=2*akcm*deltad+akct*deltat12
2985 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
2986 eom1=-2*akth*deltat1-pom1-om2*pom2
2987 eom2= 2*akth*deltat2+pom1-om1*pom2
2990 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
2993 ghpbx(k,i)=ghpbx(k,i)-gg(k)
2994 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
2995 ghpbx(k,j)=ghpbx(k,j)+gg(k)
2996 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
2999 C Calculate the components of the gradient in DC and X
3003 ghpbc(l,k)=ghpbc(l,k)+gg(l)
3008 C--------------------------------------------------------------------------
3009 subroutine ebond(estr)
3011 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3013 implicit real*8 (a-h,o-z)
3014 include 'DIMENSIONS'
3015 include 'sizesclu.dat'
3016 include 'COMMON.LOCAL'
3017 include 'COMMON.GEO'
3018 include 'COMMON.INTERACT'
3019 include 'COMMON.DERIV'
3020 include 'COMMON.VAR'
3021 include 'COMMON.CHAIN'
3022 include 'COMMON.IOUNITS'
3023 include 'COMMON.NAMES'
3024 include 'COMMON.FFIELD'
3025 include 'COMMON.CONTROL'
3026 logical energy_dec /.false./
3027 double precision u(3),ud(3)
3030 if (itype(i-1).eq.21 .or. itype(i).eq.21) then
3031 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
3033 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
3034 & *dc(j,i-1)/vbld(i)
3036 if (energy_dec) write(iout,*)
3037 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
3039 diff = vbld(i)-vbldp0
3040 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3043 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3048 estr=0.5d0*AKP*estr+estr1
3050 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3054 if (iti.ne.10 .and. iti.ne.21) then
3057 diff=vbld(i+nres)-vbldsc0(1,iti)
3058 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3059 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
3060 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3062 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3066 diff=vbld(i+nres)-vbldsc0(j,iti)
3067 ud(j)=aksc(j,iti)*diff
3068 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3082 uprod2=uprod2*u(k)*u(k)
3086 usumsqder=usumsqder+ud(j)*uprod2
3088 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
3089 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
3090 estr=estr+uprod/usum
3092 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3100 C--------------------------------------------------------------------------
3101 subroutine ebend(etheta)
3103 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3104 C angles gamma and its derivatives in consecutive thetas and gammas.
3106 implicit real*8 (a-h,o-z)
3107 include 'DIMENSIONS'
3108 include 'sizesclu.dat'
3109 include 'COMMON.LOCAL'
3110 include 'COMMON.GEO'
3111 include 'COMMON.INTERACT'
3112 include 'COMMON.DERIV'
3113 include 'COMMON.VAR'
3114 include 'COMMON.CHAIN'
3115 include 'COMMON.IOUNITS'
3116 include 'COMMON.NAMES'
3117 include 'COMMON.FFIELD'
3118 common /calcthet/ term1,term2,termm,diffak,ratak,
3119 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3120 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3121 double precision y(2),z(2)
3123 time11=dexp(-2*time)
3126 c write (iout,*) "nres",nres
3127 c write (*,'(a,i2)') 'EBEND ICG=',icg
3128 c write (iout,*) ithet_start,ithet_end
3129 do i=ithet_start,ithet_end
3130 if (itype(i-1).eq.21) cycle
3131 C Zero the energy function and its derivative at 0 or pi.
3132 call splinthet(theta(i),0.5d0*delta,ss,ssd)
3134 if (i.gt.3 .and. itype(i-2).ne.21) then
3138 call proc_proc(phii,icrc)
3139 if (icrc.eq.1) phii=150.0
3149 if (i.lt.nres .and. itype(i).ne.21) then
3153 call proc_proc(phii1,icrc)
3154 if (icrc.eq.1) phii1=150.0
3166 C Calculate the "mean" value of theta from the part of the distribution
3167 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3168 C In following comments this theta will be referred to as t_c.
3169 thet_pred_mean=0.0d0
3173 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3175 c write (iout,*) "thet_pred_mean",thet_pred_mean
3176 dthett=thet_pred_mean*ssd
3177 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3178 c write (iout,*) "thet_pred_mean",thet_pred_mean
3179 C Derivatives of the "mean" values in gamma1 and gamma2.
3180 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3181 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3182 if (theta(i).gt.pi-delta) then
3183 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3185 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3186 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3187 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3189 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3191 else if (theta(i).lt.delta) then
3192 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3193 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3194 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3196 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3197 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3200 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3203 etheta=etheta+ethetai
3204 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
3205 c & rad2deg*phii,rad2deg*phii1,ethetai
3206 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3207 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3208 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3211 C Ufff.... We've done all this!!!
3214 C---------------------------------------------------------------------------
3215 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3217 implicit real*8 (a-h,o-z)
3218 include 'DIMENSIONS'
3219 include 'COMMON.LOCAL'
3220 include 'COMMON.IOUNITS'
3221 common /calcthet/ term1,term2,termm,diffak,ratak,
3222 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3223 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3224 C Calculate the contributions to both Gaussian lobes.
3225 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3226 C The "polynomial part" of the "standard deviation" of this part of
3230 sig=sig*thet_pred_mean+polthet(j,it)
3232 C Derivative of the "interior part" of the "standard deviation of the"
3233 C gamma-dependent Gaussian lobe in t_c.
3234 sigtc=3*polthet(3,it)
3236 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3239 C Set the parameters of both Gaussian lobes of the distribution.
3240 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3241 fac=sig*sig+sigc0(it)
3244 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3245 sigsqtc=-4.0D0*sigcsq*sigtc
3246 c print *,i,sig,sigtc,sigsqtc
3247 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3248 sigtc=-sigtc/(fac*fac)
3249 C Following variable is sigma(t_c)**(-2)
3250 sigcsq=sigcsq*sigcsq
3252 sig0inv=1.0D0/sig0i**2
3253 delthec=thetai-thet_pred_mean
3254 delthe0=thetai-theta0i
3255 term1=-0.5D0*sigcsq*delthec*delthec
3256 term2=-0.5D0*sig0inv*delthe0*delthe0
3257 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3258 C NaNs in taking the logarithm. We extract the largest exponent which is added
3259 C to the energy (this being the log of the distribution) at the end of energy
3260 C term evaluation for this virtual-bond angle.
3261 if (term1.gt.term2) then
3263 term2=dexp(term2-termm)
3267 term1=dexp(term1-termm)
3270 C The ratio between the gamma-independent and gamma-dependent lobes of
3271 C the distribution is a Gaussian function of thet_pred_mean too.
3272 diffak=gthet(2,it)-thet_pred_mean
3273 ratak=diffak/gthet(3,it)**2
3274 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3275 C Let's differentiate it in thet_pred_mean NOW.
3277 C Now put together the distribution terms to make complete distribution.
3278 termexp=term1+ak*term2
3279 termpre=sigc+ak*sig0i
3280 C Contribution of the bending energy from this theta is just the -log of
3281 C the sum of the contributions from the two lobes and the pre-exponential
3282 C factor. Simple enough, isn't it?
3283 ethetai=(-dlog(termexp)-termm+dlog(termpre))
3284 C NOW the derivatives!!!
3285 C 6/6/97 Take into account the deformation.
3286 E_theta=(delthec*sigcsq*term1
3287 & +ak*delthe0*sig0inv*term2)/termexp
3288 E_tc=((sigtc+aktc*sig0i)/termpre
3289 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3290 & aktc*term2)/termexp)
3293 c-----------------------------------------------------------------------------
3294 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3295 implicit real*8 (a-h,o-z)
3296 include 'DIMENSIONS'
3297 include 'COMMON.LOCAL'
3298 include 'COMMON.IOUNITS'
3299 common /calcthet/ term1,term2,termm,diffak,ratak,
3300 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3301 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3302 delthec=thetai-thet_pred_mean
3303 delthe0=thetai-theta0i
3304 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3305 t3 = thetai-thet_pred_mean
3309 t14 = t12+t6*sigsqtc
3311 t21 = thetai-theta0i
3317 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3318 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3319 & *(-t12*t9-ak*sig0inv*t27)
3323 C--------------------------------------------------------------------------
3324 subroutine ebend(etheta)
3326 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3327 C angles gamma and its derivatives in consecutive thetas and gammas.
3328 C ab initio-derived potentials from
3329 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3331 implicit real*8 (a-h,o-z)
3332 include 'DIMENSIONS'
3333 include 'sizesclu.dat'
3334 include 'COMMON.LOCAL'
3335 include 'COMMON.GEO'
3336 include 'COMMON.INTERACT'
3337 include 'COMMON.DERIV'
3338 include 'COMMON.VAR'
3339 include 'COMMON.CHAIN'
3340 include 'COMMON.IOUNITS'
3341 include 'COMMON.NAMES'
3342 include 'COMMON.FFIELD'
3343 include 'COMMON.CONTROL'
3344 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
3345 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
3346 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
3347 & sinph1ph2(maxdouble,maxdouble)
3348 logical lprn /.false./, lprn1 /.false./
3350 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
3351 do i=ithet_start,ithet_end
3352 if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
3353 &(itype(i).eq.ntyp1)) cycle
3357 theti2=0.5d0*theta(i)
3358 ityp2=ithetyp(itype(i-1))
3360 coskt(k)=dcos(k*theti2)
3361 sinkt(k)=dsin(k*theti2)
3363 if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
3366 if (phii.ne.phii) phii=150.0
3370 ityp1=ithetyp(itype(i-2))
3372 cosph1(k)=dcos(k*phii)
3373 sinph1(k)=dsin(k*phii)
3377 ityp1=ithetyp(itype(i-2))
3383 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
3386 if (phii1.ne.phii1) phii1=150.0
3391 ityp3=ithetyp(itype(i))
3393 cosph2(k)=dcos(k*phii1)
3394 sinph2(k)=dsin(k*phii1)
3398 ityp3=ithetyp(itype(i))
3404 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
3405 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
3407 ethetai=aa0thet(ityp1,ityp2,ityp3)
3410 ccl=cosph1(l)*cosph2(k-l)
3411 ssl=sinph1(l)*sinph2(k-l)
3412 scl=sinph1(l)*cosph2(k-l)
3413 csl=cosph1(l)*sinph2(k-l)
3414 cosph1ph2(l,k)=ccl-ssl
3415 cosph1ph2(k,l)=ccl+ssl
3416 sinph1ph2(l,k)=scl+csl
3417 sinph1ph2(k,l)=scl-csl
3421 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
3422 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
3423 write (iout,*) "coskt and sinkt"
3425 write (iout,*) k,coskt(k),sinkt(k)
3429 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
3430 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
3433 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
3434 & " ethetai",ethetai
3437 write (iout,*) "cosph and sinph"
3439 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
3441 write (iout,*) "cosph1ph2 and sinph2ph2"
3444 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
3445 & sinph1ph2(l,k),sinph1ph2(k,l)
3448 write(iout,*) "ethetai",ethetai
3452 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
3453 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
3454 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
3455 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
3456 ethetai=ethetai+sinkt(m)*aux
3457 dethetai=dethetai+0.5d0*m*aux*coskt(m)
3458 dephii=dephii+k*sinkt(m)*(
3459 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
3460 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
3461 dephii1=dephii1+k*sinkt(m)*(
3462 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
3463 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
3465 & write (iout,*) "m",m," k",k," bbthet",
3466 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
3467 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
3468 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
3469 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3473 & write(iout,*) "ethetai",ethetai
3477 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3478 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
3479 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3480 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
3481 ethetai=ethetai+sinkt(m)*aux
3482 dethetai=dethetai+0.5d0*m*coskt(m)*aux
3483 dephii=dephii+l*sinkt(m)*(
3484 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
3485 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3486 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
3487 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3488 dephii1=dephii1+(k-l)*sinkt(m)*(
3489 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
3490 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
3491 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
3492 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
3494 write (iout,*) "m",m," k",k," l",l," ffthet",
3495 & ffthet(l,k,m,ityp1,ityp2,ityp3),
3496 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
3497 & ggthet(l,k,m,ityp1,ityp2,ityp3),
3498 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
3499 write (iout,*) cosph1ph2(l,k)*sinkt(m),
3500 & cosph1ph2(k,l)*sinkt(m),
3501 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
3507 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
3508 & i,theta(i)*rad2deg,phii*rad2deg,
3509 & phii1*rad2deg,ethetai
3510 etheta=etheta+ethetai
3511 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
3512 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
3513 gloc(nphi+i-2,icg)=wang*dethetai
3519 c-----------------------------------------------------------------------------
3520 subroutine esc(escloc)
3521 C Calculate the local energy of a side chain and its derivatives in the
3522 C corresponding virtual-bond valence angles THETA and the spherical angles
3524 implicit real*8 (a-h,o-z)
3525 include 'DIMENSIONS'
3526 include 'sizesclu.dat'
3527 include 'COMMON.GEO'
3528 include 'COMMON.LOCAL'
3529 include 'COMMON.VAR'
3530 include 'COMMON.INTERACT'
3531 include 'COMMON.DERIV'
3532 include 'COMMON.CHAIN'
3533 include 'COMMON.IOUNITS'
3534 include 'COMMON.NAMES'
3535 include 'COMMON.FFIELD'
3536 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
3537 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
3538 common /sccalc/ time11,time12,time112,theti,it,nlobit
3541 c write (iout,'(a)') 'ESC'
3542 do i=loc_start,loc_end
3545 if (it.eq.10) goto 1
3547 c print *,'i=',i,' it=',it,' nlobit=',nlobit
3548 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
3549 theti=theta(i+1)-pipol
3553 c write (iout,*) "i",i," x",x(1),x(2),x(3)
3555 if (x(2).gt.pi-delta) then
3559 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3561 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3562 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
3564 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3565 & ddersc0(1),dersc(1))
3566 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
3567 & ddersc0(3),dersc(3))
3569 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3571 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3572 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
3573 & dersc0(2),esclocbi,dersc02)
3574 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
3576 call splinthet(x(2),0.5d0*delta,ss,ssd)
3581 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3583 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3584 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3586 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3588 c write (iout,*) escloci
3589 else if (x(2).lt.delta) then
3593 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
3595 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
3596 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
3598 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3599 & ddersc0(1),dersc(1))
3600 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
3601 & ddersc0(3),dersc(3))
3603 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
3605 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
3606 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
3607 & dersc0(2),esclocbi,dersc02)
3608 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
3613 call splinthet(x(2),0.5d0*delta,ss,ssd)
3615 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
3617 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
3618 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
3620 escloci=ss*escloci+(1.0d0-ss)*esclocbi
3621 c write (iout,*) escloci
3623 call enesc(x,escloci,dersc,ddummy,.false.)
3626 escloc=escloc+escloci
3627 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
3629 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3631 gloc(ialph(i,1),icg)=wscloc*dersc(2)
3632 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
3637 C---------------------------------------------------------------------------
3638 subroutine enesc(x,escloci,dersc,ddersc,mixed)
3639 implicit real*8 (a-h,o-z)
3640 include 'DIMENSIONS'
3641 include 'COMMON.GEO'
3642 include 'COMMON.LOCAL'
3643 include 'COMMON.IOUNITS'
3644 common /sccalc/ time11,time12,time112,theti,it,nlobit
3645 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
3646 double precision contr(maxlob,-1:1)
3648 c write (iout,*) 'it=',it,' nlobit=',nlobit
3652 if (mixed) ddersc(j)=0.0d0
3656 C Because of periodicity of the dependence of the SC energy in omega we have
3657 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
3658 C To avoid underflows, first compute & store the exponents.
3666 z(k)=x(k)-censc(k,j,it)
3671 Axk=Axk+gaussc(l,k,j,it)*z(l)
3677 expfac=expfac+Ax(k,j,iii)*z(k)
3685 C As in the case of ebend, we want to avoid underflows in exponentiation and
3686 C subsequent NaNs and INFs in energy calculation.
3687 C Find the largest exponent
3691 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
3695 cd print *,'it=',it,' emin=',emin
3697 C Compute the contribution to SC energy and derivatives
3701 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
3702 cd print *,'j=',j,' expfac=',expfac
3703 escloc_i=escloc_i+expfac
3705 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
3709 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
3710 & +gaussc(k,2,j,it))*expfac
3717 dersc(1)=dersc(1)/cos(theti)**2
3718 ddersc(1)=ddersc(1)/cos(theti)**2
3721 escloci=-(dlog(escloc_i)-emin)
3723 dersc(j)=dersc(j)/escloc_i
3727 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
3732 C------------------------------------------------------------------------------
3733 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
3734 implicit real*8 (a-h,o-z)
3735 include 'DIMENSIONS'
3736 include 'COMMON.GEO'
3737 include 'COMMON.LOCAL'
3738 include 'COMMON.IOUNITS'
3739 common /sccalc/ time11,time12,time112,theti,it,nlobit
3740 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
3741 double precision contr(maxlob)
3752 z(k)=x(k)-censc(k,j,it)
3758 Axk=Axk+gaussc(l,k,j,it)*z(l)
3764 expfac=expfac+Ax(k,j)*z(k)
3769 C As in the case of ebend, we want to avoid underflows in exponentiation and
3770 C subsequent NaNs and INFs in energy calculation.
3771 C Find the largest exponent
3774 if (emin.gt.contr(j)) emin=contr(j)
3778 C Compute the contribution to SC energy and derivatives
3782 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
3783 escloc_i=escloc_i+expfac
3785 dersc(k)=dersc(k)+Ax(k,j)*expfac
3787 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
3788 & +gaussc(1,2,j,it))*expfac
3792 dersc(1)=dersc(1)/cos(theti)**2
3793 dersc12=dersc12/cos(theti)**2
3794 escloci=-(dlog(escloc_i)-emin)
3796 dersc(j)=dersc(j)/escloc_i
3798 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
3802 c----------------------------------------------------------------------------------
3803 subroutine esc(escloc)
3804 C Calculate the local energy of a side chain and its derivatives in the
3805 C corresponding virtual-bond valence angles THETA and the spherical angles
3806 C ALPHA and OMEGA derived from AM1 all-atom calculations.
3807 C added by Urszula Kozlowska. 07/11/2007
3809 implicit real*8 (a-h,o-z)
3810 include 'DIMENSIONS'
3811 include 'sizesclu.dat'
3812 include 'COMMON.GEO'
3813 include 'COMMON.LOCAL'
3814 include 'COMMON.VAR'
3815 include 'COMMON.SCROT'
3816 include 'COMMON.INTERACT'
3817 include 'COMMON.DERIV'
3818 include 'COMMON.CHAIN'
3819 include 'COMMON.IOUNITS'
3820 include 'COMMON.NAMES'
3821 include 'COMMON.FFIELD'
3822 include 'COMMON.CONTROL'
3823 include 'COMMON.VECTORS'
3824 double precision x_prime(3),y_prime(3),z_prime(3)
3825 & , sumene,dsc_i,dp2_i,x(65),
3826 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
3827 & de_dxx,de_dyy,de_dzz,de_dt
3828 double precision s1_t,s1_6_t,s2_t,s2_6_t
3830 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
3831 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
3832 & dt_dCi(3),dt_dCi1(3)
3833 common /sccalc/ time11,time12,time112,theti,it,nlobit
3836 do i=loc_start,loc_end
3837 if (itype(i).eq.21) cycle
3838 costtab(i+1) =dcos(theta(i+1))
3839 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
3840 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
3841 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
3842 cosfac2=0.5d0/(1.0d0+costtab(i+1))
3843 cosfac=dsqrt(cosfac2)
3844 sinfac2=0.5d0/(1.0d0-costtab(i+1))
3845 sinfac=dsqrt(sinfac2)
3847 if (it.eq.10) goto 1
3849 C Compute the axes of tghe local cartesian coordinates system; store in
3850 c x_prime, y_prime and z_prime
3857 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
3858 C & dc_norm(3,i+nres)
3860 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
3861 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
3864 z_prime(j) = -uz(j,i-1)
3867 c write (2,*) "x_prime",(x_prime(j),j=1,3)
3868 c write (2,*) "y_prime",(y_prime(j),j=1,3)
3869 c write (2,*) "z_prime",(z_prime(j),j=1,3)
3870 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
3871 c & " xy",scalar(x_prime(1),y_prime(1)),
3872 c & " xz",scalar(x_prime(1),z_prime(1)),
3873 c & " yy",scalar(y_prime(1),y_prime(1)),
3874 c & " yz",scalar(y_prime(1),z_prime(1)),
3875 c & " zz",scalar(z_prime(1),z_prime(1))
3877 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
3878 C to local coordinate system. Store in xx, yy, zz.
3884 xx = xx + x_prime(j)*dc_norm(j,i+nres)
3885 yy = yy + y_prime(j)*dc_norm(j,i+nres)
3886 zz = zz + z_prime(j)*dc_norm(j,i+nres)
3893 C Compute the energy of the ith side cbain
3895 c write (2,*) "xx",xx," yy",yy," zz",zz
3898 x(j) = sc_parmin(j,it)
3901 Cc diagnostics - remove later
3903 yy1 = dsin(alph(2))*dcos(omeg(2))
3904 zz1 = -dsin(alph(2))*dsin(omeg(2))
3905 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
3906 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
3908 C," --- ", xx_w,yy_w,zz_w
3911 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
3912 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
3914 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
3915 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
3917 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
3918 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
3919 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
3920 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
3921 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
3923 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
3924 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
3925 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
3926 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
3927 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
3929 dsc_i = 0.743d0+x(61)
3931 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3932 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
3933 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
3934 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
3935 s1=(1+x(63))/(0.1d0 + dscp1)
3936 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
3937 s2=(1+x(65))/(0.1d0 + dscp2)
3938 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
3939 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
3940 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
3941 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
3943 c & dscp1,dscp2,sumene
3944 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3945 escloc = escloc + sumene
3946 c write (2,*) "escloc",escloc
3947 if (.not. calc_grad) goto 1
3950 C This section to check the numerical derivatives of the energy of ith side
3951 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
3952 C #define DEBUG in the code to turn it on.
3954 write (2,*) "sumene =",sumene
3958 write (2,*) xx,yy,zz
3959 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3960 de_dxx_num=(sumenep-sumene)/aincr
3962 write (2,*) "xx+ sumene from enesc=",sumenep
3965 write (2,*) xx,yy,zz
3966 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3967 de_dyy_num=(sumenep-sumene)/aincr
3969 write (2,*) "yy+ sumene from enesc=",sumenep
3972 write (2,*) xx,yy,zz
3973 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3974 de_dzz_num=(sumenep-sumene)/aincr
3976 write (2,*) "zz+ sumene from enesc=",sumenep
3977 costsave=cost2tab(i+1)
3978 sintsave=sint2tab(i+1)
3979 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
3980 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
3981 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
3982 de_dt_num=(sumenep-sumene)/aincr
3983 write (2,*) " t+ sumene from enesc=",sumenep
3984 cost2tab(i+1)=costsave
3985 sint2tab(i+1)=sintsave
3986 C End of diagnostics section.
3989 C Compute the gradient of esc
3991 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
3992 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
3993 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
3994 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
3995 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
3996 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
3997 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
3998 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
3999 pom1=(sumene3*sint2tab(i+1)+sumene1)
4000 & *(pom_s1/dscp1+pom_s16*dscp1**4)
4001 pom2=(sumene4*cost2tab(i+1)+sumene2)
4002 & *(pom_s2/dscp2+pom_s26*dscp2**4)
4003 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4004 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4005 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4007 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4008 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4009 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4011 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4012 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4013 & +(pom1+pom2)*pom_dx
4015 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4018 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4019 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4020 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4022 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4023 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4024 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4025 & +x(59)*zz**2 +x(60)*xx*zz
4026 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4027 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4028 & +(pom1-pom2)*pom_dy
4030 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4033 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4034 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4035 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4036 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
4037 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
4038 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4039 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4040 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
4042 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4045 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4046 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4047 & +pom1*pom_dt1+pom2*pom_dt2
4049 write(2,*), "de_dt = ", de_dt,de_dt_num
4053 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4054 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4055 cosfac2xx=cosfac2*xx
4056 sinfac2yy=sinfac2*yy
4058 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4060 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4062 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4063 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4064 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4065 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4066 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4067 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4068 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4069 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4070 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4071 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4075 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4076 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4079 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4080 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4081 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4083 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4084 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4088 dXX_Ctab(k,i)=dXX_Ci(k)
4089 dXX_C1tab(k,i)=dXX_Ci1(k)
4090 dYY_Ctab(k,i)=dYY_Ci(k)
4091 dYY_C1tab(k,i)=dYY_Ci1(k)
4092 dZZ_Ctab(k,i)=dZZ_Ci(k)
4093 dZZ_C1tab(k,i)=dZZ_Ci1(k)
4094 dXX_XYZtab(k,i)=dXX_XYZ(k)
4095 dYY_XYZtab(k,i)=dYY_XYZ(k)
4096 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4100 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4101 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4102 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4103 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
4104 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4106 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4107 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4108 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4109 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4110 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4111 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4112 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
4113 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4115 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4116 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4118 C to check gradient call subroutine check_grad
4125 c------------------------------------------------------------------------------
4126 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4128 C This procedure calculates two-body contact function g(rij) and its derivative:
4131 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
4134 C where x=(rij-r0ij)/delta
4136 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4139 double precision rij,r0ij,eps0ij,fcont,fprimcont
4140 double precision x,x2,x4,delta
4144 if (x.lt.-1.0D0) then
4147 else if (x.le.1.0D0) then
4150 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4151 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4158 c------------------------------------------------------------------------------
4159 subroutine splinthet(theti,delta,ss,ssder)
4160 implicit real*8 (a-h,o-z)
4161 include 'DIMENSIONS'
4162 include 'sizesclu.dat'
4163 include 'COMMON.VAR'
4164 include 'COMMON.GEO'
4167 if (theti.gt.pipol) then
4168 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4170 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4175 c------------------------------------------------------------------------------
4176 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4178 double precision x,x0,delta,f0,f1,fprim0,f,fprim
4179 double precision ksi,ksi2,ksi3,a1,a2,a3
4180 a1=fprim0*delta/(f1-f0)
4186 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4187 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4190 c------------------------------------------------------------------------------
4191 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4193 double precision x,x0,delta,f0x,f1x,fprim0x,fx
4194 double precision ksi,ksi2,ksi3,a1,a2,a3
4199 a2=3*(f1x-f0x)-2*fprim0x*delta
4200 a3=fprim0x*delta-2*(f1x-f0x)
4201 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4204 C-----------------------------------------------------------------------------
4206 C-----------------------------------------------------------------------------
4207 subroutine etor(etors,edihcnstr,fact)
4208 implicit real*8 (a-h,o-z)
4209 include 'DIMENSIONS'
4210 include 'sizesclu.dat'
4211 include 'COMMON.VAR'
4212 include 'COMMON.GEO'
4213 include 'COMMON.LOCAL'
4214 include 'COMMON.TORSION'
4215 include 'COMMON.INTERACT'
4216 include 'COMMON.DERIV'
4217 include 'COMMON.CHAIN'
4218 include 'COMMON.NAMES'
4219 include 'COMMON.IOUNITS'
4220 include 'COMMON.FFIELD'
4221 include 'COMMON.TORCNSTR'
4223 C Set lprn=.true. for debugging
4227 do i=iphi_start,iphi_end
4228 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
4229 & .or. itype(i).eq.21) cycle
4230 itori=itortyp(itype(i-2))
4231 itori1=itortyp(itype(i-1))
4234 C Proline-Proline pair is a special case...
4235 if (itori.eq.3 .and. itori1.eq.3) then
4236 if (phii.gt.-dwapi3) then
4238 fac=1.0D0/(1.0D0-cosphi)
4239 etorsi=v1(1,3,3)*fac
4240 etorsi=etorsi+etorsi
4241 etors=etors+etorsi-v1(1,3,3)
4242 gloci=gloci-3*fac*etorsi*dsin(3*phii)
4245 v1ij=v1(j+1,itori,itori1)
4246 v2ij=v2(j+1,itori,itori1)
4249 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4250 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4254 v1ij=v1(j,itori,itori1)
4255 v2ij=v2(j,itori,itori1)
4258 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4259 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4263 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4264 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4265 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4266 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4267 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4269 ! 6/20/98 - dihedral angle constraints
4272 itori=idih_constr(i)
4275 if (difi.gt.drange(i)) then
4277 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4278 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4279 else if (difi.lt.-drange(i)) then
4281 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4282 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4284 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4285 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4287 ! write (iout,*) 'edihcnstr',edihcnstr
4290 c------------------------------------------------------------------------------
4292 subroutine etor(etors,edihcnstr,fact)
4293 implicit real*8 (a-h,o-z)
4294 include 'DIMENSIONS'
4295 include 'sizesclu.dat'
4296 include 'COMMON.VAR'
4297 include 'COMMON.GEO'
4298 include 'COMMON.LOCAL'
4299 include 'COMMON.TORSION'
4300 include 'COMMON.INTERACT'
4301 include 'COMMON.DERIV'
4302 include 'COMMON.CHAIN'
4303 include 'COMMON.NAMES'
4304 include 'COMMON.IOUNITS'
4305 include 'COMMON.FFIELD'
4306 include 'COMMON.TORCNSTR'
4308 C Set lprn=.true. for debugging
4312 do i=iphi_start,iphi_end
4313 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
4314 & .or. itype(i).eq.21) cycle
4315 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
4316 itori=itortyp(itype(i-2))
4317 itori1=itortyp(itype(i-1))
4320 C Regular cosine and sine terms
4321 do j=1,nterm(itori,itori1)
4322 v1ij=v1(j,itori,itori1)
4323 v2ij=v2(j,itori,itori1)
4326 etors=etors+v1ij*cosphi+v2ij*sinphi
4327 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4331 C E = SUM ----------------------------------- - v1
4332 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
4334 cosphi=dcos(0.5d0*phii)
4335 sinphi=dsin(0.5d0*phii)
4336 do j=1,nlor(itori,itori1)
4337 vl1ij=vlor1(j,itori,itori1)
4338 vl2ij=vlor2(j,itori,itori1)
4339 vl3ij=vlor3(j,itori,itori1)
4340 pom=vl2ij*cosphi+vl3ij*sinphi
4341 pom1=1.0d0/(pom*pom+1.0d0)
4342 etors=etors+vl1ij*pom1
4344 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
4346 C Subtract the constant term
4347 etors=etors-v0(itori,itori1)
4349 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4350 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4351 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4352 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
4353 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4356 ! 6/20/98 - dihedral angle constraints
4359 itori=idih_constr(i)
4361 difi=pinorm(phii-phi0(i))
4363 if (difi.gt.drange(i)) then
4365 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4366 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4367 edihi=0.25d0*ftors*difi**4
4368 else if (difi.lt.-drange(i)) then
4370 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4371 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4372 edihi=0.25d0*ftors*difi**4
4376 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
4378 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4379 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4381 ! write (iout,*) 'edihcnstr',edihcnstr
4384 c----------------------------------------------------------------------------
4385 subroutine etor_d(etors_d,fact2)
4386 C 6/23/01 Compute double torsional energy
4387 implicit real*8 (a-h,o-z)
4388 include 'DIMENSIONS'
4389 include 'sizesclu.dat'
4390 include 'COMMON.VAR'
4391 include 'COMMON.GEO'
4392 include 'COMMON.LOCAL'
4393 include 'COMMON.TORSION'
4394 include 'COMMON.INTERACT'
4395 include 'COMMON.DERIV'
4396 include 'COMMON.CHAIN'
4397 include 'COMMON.NAMES'
4398 include 'COMMON.IOUNITS'
4399 include 'COMMON.FFIELD'
4400 include 'COMMON.TORCNSTR'
4402 C Set lprn=.true. for debugging
4406 do i=iphi_start,iphi_end-1
4407 if (itype(i-2).eq.21 .or. itype(i-1).eq.21
4408 & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle
4409 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
4411 itori=itortyp(itype(i-2))
4412 itori1=itortyp(itype(i-1))
4413 itori2=itortyp(itype(i))
4418 C Regular cosine and sine terms
4419 do j=1,ntermd_1(itori,itori1,itori2)
4420 v1cij=v1c(1,j,itori,itori1,itori2)
4421 v1sij=v1s(1,j,itori,itori1,itori2)
4422 v2cij=v1c(2,j,itori,itori1,itori2)
4423 v2sij=v1s(2,j,itori,itori1,itori2)
4424 cosphi1=dcos(j*phii)
4425 sinphi1=dsin(j*phii)
4426 cosphi2=dcos(j*phii1)
4427 sinphi2=dsin(j*phii1)
4428 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
4429 & v2cij*cosphi2+v2sij*sinphi2
4430 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
4431 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
4433 do k=2,ntermd_2(itori,itori1,itori2)
4435 v1cdij = v2c(k,l,itori,itori1,itori2)
4436 v2cdij = v2c(l,k,itori,itori1,itori2)
4437 v1sdij = v2s(k,l,itori,itori1,itori2)
4438 v2sdij = v2s(l,k,itori,itori1,itori2)
4439 cosphi1p2=dcos(l*phii+(k-l)*phii1)
4440 cosphi1m2=dcos(l*phii-(k-l)*phii1)
4441 sinphi1p2=dsin(l*phii+(k-l)*phii1)
4442 sinphi1m2=dsin(l*phii-(k-l)*phii1)
4443 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
4444 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
4445 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
4446 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
4447 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
4448 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
4451 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
4452 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
4458 c------------------------------------------------------------------------------
4459 subroutine eback_sc_corr(esccor)
4460 c 7/21/2007 Correlations between the backbone-local and side-chain-local
4461 c conformational states; temporarily implemented as differences
4462 c between UNRES torsional potentials (dependent on three types of
4463 c residues) and the torsional potentials dependent on all 20 types
4464 c of residues computed from AM1 energy surfaces of terminally-blocked
4465 c amino-acid residues.
4466 implicit real*8 (a-h,o-z)
4467 include 'DIMENSIONS'
4468 include 'sizesclu.dat'
4469 include 'COMMON.VAR'
4470 include 'COMMON.GEO'
4471 include 'COMMON.LOCAL'
4472 include 'COMMON.TORSION'
4473 include 'COMMON.SCCOR'
4474 include 'COMMON.INTERACT'
4475 include 'COMMON.DERIV'
4476 include 'COMMON.CHAIN'
4477 include 'COMMON.NAMES'
4478 include 'COMMON.IOUNITS'
4479 include 'COMMON.FFIELD'
4480 include 'COMMON.CONTROL'
4482 C Set lprn=.true. for debugging
4485 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
4487 do i=itau_start,itau_end
4488 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1) cycle
4490 isccori=isccortyp(itype(i-2))
4491 isccori1=isccortyp(itype(i-1))
4493 do intertyp=1,3 !intertyp
4494 cc Added 09 May 2012 (Adasko)
4495 cc Intertyp means interaction type of backbone mainchain correlation:
4496 c 1 = SC...Ca...Ca...Ca
4497 c 2 = Ca...Ca...Ca...SC
4498 c 3 = SC...Ca...Ca...SCi
4500 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
4501 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
4502 & (itype(i-1).eq.ntyp1)))
4503 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
4504 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
4505 & .or.(itype(i).eq.ntyp1)))
4506 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
4507 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
4508 & (itype(i-3).eq.ntyp1)))) cycle
4509 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
4510 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
4512 do j=1,nterm_sccor(isccori,isccori1)
4513 v1ij=v1sccor(j,intertyp,isccori,isccori1)
4514 v2ij=v2sccor(j,intertyp,isccori,isccori1)
4515 cosphi=dcos(j*tauangle(intertyp,i))
4516 sinphi=dsin(j*tauangle(intertyp,i))
4517 esccor=esccor+v1ij*cosphi+v2ij*sinphi
4518 c gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4520 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
4521 c gloc_sc(intertyp,i-3)=gloc_sc(intertyp,i-3)+wsccor*gloci
4523 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4524 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4525 & (v1sccor(j,1,itori,itori1),j=1,6),
4526 & (v2sccor(j,1,itori,itori1),j=1,6)
4527 gsccor_loc(i-3)=gloci
4532 c------------------------------------------------------------------------------
4533 subroutine multibody(ecorr)
4534 C This subroutine calculates multi-body contributions to energy following
4535 C the idea of Skolnick et al. If side chains I and J make a contact and
4536 C at the same time side chains I+1 and J+1 make a contact, an extra
4537 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
4538 implicit real*8 (a-h,o-z)
4539 include 'DIMENSIONS'
4540 include 'COMMON.IOUNITS'
4541 include 'COMMON.DERIV'
4542 include 'COMMON.INTERACT'
4543 include 'COMMON.CONTACTS'
4544 double precision gx(3),gx1(3)
4547 C Set lprn=.true. for debugging
4551 write (iout,'(a)') 'Contact function values:'
4553 write (iout,'(i2,20(1x,i2,f10.5))')
4554 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
4569 num_conti=num_cont(i)
4570 num_conti1=num_cont(i1)
4575 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
4576 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4577 cd & ' ishift=',ishift
4578 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
4579 C The system gains extra energy.
4580 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
4581 endif ! j1==j+-ishift
4590 c------------------------------------------------------------------------------
4591 double precision function esccorr(i,j,k,l,jj,kk)
4592 implicit real*8 (a-h,o-z)
4593 include 'DIMENSIONS'
4594 include 'COMMON.IOUNITS'
4595 include 'COMMON.DERIV'
4596 include 'COMMON.INTERACT'
4597 include 'COMMON.CONTACTS'
4598 double precision gx(3),gx1(3)
4603 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
4604 C Calculate the multi-body contribution to energy.
4605 C Calculate multi-body contributions to the gradient.
4606 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
4607 cd & k,l,(gacont(m,kk,k),m=1,3)
4609 gx(m) =ekl*gacont(m,jj,i)
4610 gx1(m)=eij*gacont(m,kk,k)
4611 gradxorr(m,i)=gradxorr(m,i)-gx(m)
4612 gradxorr(m,j)=gradxorr(m,j)+gx(m)
4613 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
4614 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
4618 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
4623 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
4629 c------------------------------------------------------------------------------
4631 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
4632 implicit real*8 (a-h,o-z)
4633 include 'DIMENSIONS'
4634 integer dimen1,dimen2,atom,indx
4635 double precision buffer(dimen1,dimen2)
4636 double precision zapas
4637 common /contacts_hb/ zapas(3,20,maxres,7),
4638 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4639 & num_cont_hb(maxres),jcont_hb(20,maxres)
4640 num_kont=num_cont_hb(atom)
4644 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
4647 buffer(i,indx+22)=facont_hb(i,atom)
4648 buffer(i,indx+23)=ees0p(i,atom)
4649 buffer(i,indx+24)=ees0m(i,atom)
4650 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
4652 buffer(1,indx+26)=dfloat(num_kont)
4655 c------------------------------------------------------------------------------
4656 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
4657 implicit real*8 (a-h,o-z)
4658 include 'DIMENSIONS'
4659 integer dimen1,dimen2,atom,indx
4660 double precision buffer(dimen1,dimen2)
4661 double precision zapas
4662 common /contacts_hb/ zapas(3,20,maxres,7),
4663 & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres),
4664 & num_cont_hb(maxres),jcont_hb(20,maxres)
4665 num_kont=buffer(1,indx+26)
4666 num_kont_old=num_cont_hb(atom)
4667 num_cont_hb(atom)=num_kont+num_kont_old
4672 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
4675 facont_hb(ii,atom)=buffer(i,indx+22)
4676 ees0p(ii,atom)=buffer(i,indx+23)
4677 ees0m(ii,atom)=buffer(i,indx+24)
4678 jcont_hb(ii,atom)=buffer(i,indx+25)
4682 c------------------------------------------------------------------------------
4684 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
4685 C This subroutine calculates multi-body contributions to hydrogen-bonding
4686 implicit real*8 (a-h,o-z)
4687 include 'DIMENSIONS'
4688 include 'sizesclu.dat'
4689 include 'COMMON.IOUNITS'
4691 include 'COMMON.INFO'
4693 include 'COMMON.FFIELD'
4694 include 'COMMON.DERIV'
4695 include 'COMMON.INTERACT'
4696 include 'COMMON.CONTACTS'
4698 parameter (max_cont=maxconts)
4699 parameter (max_dim=2*(8*3+2))
4700 parameter (msglen1=max_cont*max_dim*4)
4701 parameter (msglen2=2*msglen1)
4702 integer source,CorrelType,CorrelID,Error
4703 double precision buffer(max_cont,max_dim)
4705 double precision gx(3),gx1(3)
4708 C Set lprn=.true. for debugging
4713 if (fgProcs.le.1) goto 30
4715 write (iout,'(a)') 'Contact function values:'
4717 write (iout,'(2i3,50(1x,i2,f5.2))')
4718 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4719 & j=1,num_cont_hb(i))
4722 C Caution! Following code assumes that electrostatic interactions concerning
4723 C a given atom are split among at most two processors!
4733 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4736 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4737 if (MyRank.gt.0) then
4738 C Send correlation contributions to the preceding processor
4740 nn=num_cont_hb(iatel_s)
4741 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4742 cd write (iout,*) 'The BUFFER array:'
4744 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4746 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4748 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4749 C Clear the contacts of the atom passed to the neighboring processor
4750 nn=num_cont_hb(iatel_s+1)
4752 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4754 num_cont_hb(iatel_s)=0
4756 cd write (iout,*) 'Processor ',MyID,MyRank,
4757 cd & ' is sending correlation contribution to processor',MyID-1,
4758 cd & ' msglen=',msglen
4759 cd write (*,*) 'Processor ',MyID,MyRank,
4760 cd & ' is sending correlation contribution to processor',MyID-1,
4761 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4762 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4763 cd write (iout,*) 'Processor ',MyID,
4764 cd & ' has sent correlation contribution to processor',MyID-1,
4765 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4766 cd write (*,*) 'Processor ',MyID,
4767 cd & ' has sent correlation contribution to processor',MyID-1,
4768 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4770 endif ! (MyRank.gt.0)
4774 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4775 if (MyRank.lt.fgProcs-1) then
4776 C Receive correlation contributions from the next processor
4778 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4779 cd write (iout,*) 'Processor',MyID,
4780 cd & ' is receiving correlation contribution from processor',MyID+1,
4781 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4782 cd write (*,*) 'Processor',MyID,
4783 cd & ' is receiving correlation contribution from processor',MyID+1,
4784 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4786 do while (nbytes.le.0)
4787 call mp_probe(MyID+1,CorrelType,nbytes)
4789 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4790 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4791 cd write (iout,*) 'Processor',MyID,
4792 cd & ' has received correlation contribution from processor',MyID+1,
4793 cd & ' msglen=',msglen,' nbytes=',nbytes
4794 cd write (iout,*) 'The received BUFFER array:'
4796 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4798 if (msglen.eq.msglen1) then
4799 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4800 else if (msglen.eq.msglen2) then
4801 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4802 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4805 & 'ERROR!!!! message length changed while processing correlations.'
4807 & 'ERROR!!!! message length changed while processing correlations.'
4808 call mp_stopall(Error)
4809 endif ! msglen.eq.msglen1
4810 endif ! MyRank.lt.fgProcs-1
4817 write (iout,'(a)') 'Contact function values:'
4819 write (iout,'(2i3,50(1x,i2,f5.2))')
4820 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4821 & j=1,num_cont_hb(i))
4825 C Remove the loop below after debugging !!!
4832 C Calculate the local-electrostatic correlation terms
4833 do i=iatel_s,iatel_e+1
4835 num_conti=num_cont_hb(i)
4836 num_conti1=num_cont_hb(i+1)
4841 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4842 c & ' jj=',jj,' kk=',kk
4843 if (j1.eq.j+1 .or. j1.eq.j-1) then
4844 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
4845 C The system gains extra energy.
4846 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
4848 else if (j1.eq.j) then
4849 C Contacts I-J and I-(J+1) occur simultaneously.
4850 C The system loses extra energy.
4851 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
4856 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
4857 c & ' jj=',jj,' kk=',kk
4859 C Contacts I-J and (I+1)-J occur simultaneously.
4860 C The system loses extra energy.
4861 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
4868 c------------------------------------------------------------------------------
4869 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
4871 C This subroutine calculates multi-body contributions to hydrogen-bonding
4872 implicit real*8 (a-h,o-z)
4873 include 'DIMENSIONS'
4874 include 'sizesclu.dat'
4875 include 'COMMON.IOUNITS'
4877 include 'COMMON.INFO'
4879 include 'COMMON.FFIELD'
4880 include 'COMMON.DERIV'
4881 include 'COMMON.INTERACT'
4882 include 'COMMON.CONTACTS'
4884 parameter (max_cont=maxconts)
4885 parameter (max_dim=2*(8*3+2))
4886 parameter (msglen1=max_cont*max_dim*4)
4887 parameter (msglen2=2*msglen1)
4888 integer source,CorrelType,CorrelID,Error
4889 double precision buffer(max_cont,max_dim)
4891 double precision gx(3),gx1(3)
4894 C Set lprn=.true. for debugging
4900 if (fgProcs.le.1) goto 30
4902 write (iout,'(a)') 'Contact function values:'
4904 write (iout,'(2i3,50(1x,i2,f5.2))')
4905 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
4906 & j=1,num_cont_hb(i))
4909 C Caution! Following code assumes that electrostatic interactions concerning
4910 C a given atom are split among at most two processors!
4920 cd write (iout,*) 'MyRank',MyRank,' mm',mm
4923 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
4924 if (MyRank.gt.0) then
4925 C Send correlation contributions to the preceding processor
4927 nn=num_cont_hb(iatel_s)
4928 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
4929 cd write (iout,*) 'The BUFFER array:'
4931 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
4933 if (ielstart(iatel_s).gt.iatel_s+ispp) then
4935 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
4936 C Clear the contacts of the atom passed to the neighboring processor
4937 nn=num_cont_hb(iatel_s+1)
4939 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
4941 num_cont_hb(iatel_s)=0
4943 cd write (iout,*) 'Processor ',MyID,MyRank,
4944 cd & ' is sending correlation contribution to processor',MyID-1,
4945 cd & ' msglen=',msglen
4946 cd write (*,*) 'Processor ',MyID,MyRank,
4947 cd & ' is sending correlation contribution to processor',MyID-1,
4948 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4949 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
4950 cd write (iout,*) 'Processor ',MyID,
4951 cd & ' has sent correlation contribution to processor',MyID-1,
4952 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4953 cd write (*,*) 'Processor ',MyID,
4954 cd & ' has sent correlation contribution to processor',MyID-1,
4955 cd & ' msglen=',msglen,' CorrelID=',CorrelID
4957 endif ! (MyRank.gt.0)
4961 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
4962 if (MyRank.lt.fgProcs-1) then
4963 C Receive correlation contributions from the next processor
4965 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
4966 cd write (iout,*) 'Processor',MyID,
4967 cd & ' is receiving correlation contribution from processor',MyID+1,
4968 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4969 cd write (*,*) 'Processor',MyID,
4970 cd & ' is receiving correlation contribution from processor',MyID+1,
4971 cd & ' msglen=',msglen,' CorrelType=',CorrelType
4973 do while (nbytes.le.0)
4974 call mp_probe(MyID+1,CorrelType,nbytes)
4976 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
4977 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
4978 cd write (iout,*) 'Processor',MyID,
4979 cd & ' has received correlation contribution from processor',MyID+1,
4980 cd & ' msglen=',msglen,' nbytes=',nbytes
4981 cd write (iout,*) 'The received BUFFER array:'
4983 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
4985 if (msglen.eq.msglen1) then
4986 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
4987 else if (msglen.eq.msglen2) then
4988 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
4989 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
4992 & 'ERROR!!!! message length changed while processing correlations.'
4994 & 'ERROR!!!! message length changed while processing correlations.'
4995 call mp_stopall(Error)
4996 endif ! msglen.eq.msglen1
4997 endif ! MyRank.lt.fgProcs-1
5004 write (iout,'(a)') 'Contact function values:'
5006 write (iout,'(2i3,50(1x,i2,f5.2))')
5007 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5008 & j=1,num_cont_hb(i))
5014 C Remove the loop below after debugging !!!
5021 C Calculate the dipole-dipole interaction energies
5022 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5023 do i=iatel_s,iatel_e+1
5024 num_conti=num_cont_hb(i)
5031 C Calculate the local-electrostatic correlation terms
5032 do i=iatel_s,iatel_e+1
5034 num_conti=num_cont_hb(i)
5035 num_conti1=num_cont_hb(i+1)
5040 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5041 c & ' jj=',jj,' kk=',kk
5042 if (j1.eq.j+1 .or. j1.eq.j-1) then
5043 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5044 C The system gains extra energy.
5046 sqd1=dsqrt(d_cont(jj,i))
5047 sqd2=dsqrt(d_cont(kk,i1))
5048 sred_geom = sqd1*sqd2
5049 IF (sred_geom.lt.cutoff_corr) THEN
5050 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5052 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5053 c & ' jj=',jj,' kk=',kk
5054 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5055 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5057 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5058 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5061 cd write (iout,*) 'sred_geom=',sred_geom,
5062 cd & ' ekont=',ekont,' fprim=',fprimcont
5063 call calc_eello(i,j,i+1,j1,jj,kk)
5064 if (wcorr4.gt.0.0d0)
5065 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5066 if (wcorr5.gt.0.0d0)
5067 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5068 c print *,"wcorr5",ecorr5
5069 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5070 cd write(2,*)'ijkl',i,j,i+1,j1
5071 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5072 & .or. wturn6.eq.0.0d0))then
5073 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5074 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5075 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5076 cd & 'ecorr6=',ecorr6
5077 cd write (iout,'(4e15.5)') sred_geom,
5078 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
5079 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
5080 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
5081 else if (wturn6.gt.0.0d0
5082 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5083 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5084 eturn6=eturn6+eello_turn6(i,jj,kk)
5085 cd write (2,*) 'multibody_eello:eturn6',eturn6
5089 else if (j1.eq.j) then
5090 C Contacts I-J and I-(J+1) occur simultaneously.
5091 C The system loses extra energy.
5092 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5097 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5098 c & ' jj=',jj,' kk=',kk
5100 C Contacts I-J and (I+1)-J occur simultaneously.
5101 C The system loses extra energy.
5102 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5109 c------------------------------------------------------------------------------
5110 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5111 implicit real*8 (a-h,o-z)
5112 include 'DIMENSIONS'
5113 include 'COMMON.IOUNITS'
5114 include 'COMMON.DERIV'
5115 include 'COMMON.INTERACT'
5116 include 'COMMON.CONTACTS'
5117 double precision gx(3),gx1(3)
5127 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5128 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5129 C Following 4 lines for diagnostics.
5134 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
5136 c write (iout,*)'Contacts have occurred for peptide groups',
5137 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5138 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5139 C Calculate the multi-body contribution to energy.
5140 ecorr=ecorr+ekont*ees
5142 C Calculate multi-body contributions to the gradient.
5144 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5145 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5146 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5147 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5148 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5149 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5150 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5151 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5152 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5153 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5154 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5155 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5156 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5157 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5161 gradcorr(ll,m)=gradcorr(ll,m)+
5162 & ees*ekl*gacont_hbr(ll,jj,i)-
5163 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5164 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5169 gradcorr(ll,m)=gradcorr(ll,m)+
5170 & ees*eij*gacont_hbr(ll,kk,k)-
5171 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5172 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5179 C---------------------------------------------------------------------------
5180 subroutine dipole(i,j,jj)
5181 implicit real*8 (a-h,o-z)
5182 include 'DIMENSIONS'
5183 include 'sizesclu.dat'
5184 include 'COMMON.IOUNITS'
5185 include 'COMMON.CHAIN'
5186 include 'COMMON.FFIELD'
5187 include 'COMMON.DERIV'
5188 include 'COMMON.INTERACT'
5189 include 'COMMON.CONTACTS'
5190 include 'COMMON.TORSION'
5191 include 'COMMON.VAR'
5192 include 'COMMON.GEO'
5193 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5195 iti1 = itortyp(itype(i+1))
5196 if (j.lt.nres-1) then
5197 itj1 = itortyp(itype(j+1))
5202 dipi(iii,1)=Ub2(iii,i)
5203 dipderi(iii)=Ub2der(iii,i)
5204 dipi(iii,2)=b1(iii,iti1)
5205 dipj(iii,1)=Ub2(iii,j)
5206 dipderj(iii)=Ub2der(iii,j)
5207 dipj(iii,2)=b1(iii,itj1)
5211 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5214 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5217 if (.not.calc_grad) return
5222 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5226 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5231 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5232 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5234 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5236 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5238 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5242 C---------------------------------------------------------------------------
5243 subroutine calc_eello(i,j,k,l,jj,kk)
5245 C This subroutine computes matrices and vectors needed to calculate
5246 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5248 implicit real*8 (a-h,o-z)
5249 include 'DIMENSIONS'
5250 include 'sizesclu.dat'
5251 include 'COMMON.IOUNITS'
5252 include 'COMMON.CHAIN'
5253 include 'COMMON.DERIV'
5254 include 'COMMON.INTERACT'
5255 include 'COMMON.CONTACTS'
5256 include 'COMMON.TORSION'
5257 include 'COMMON.VAR'
5258 include 'COMMON.GEO'
5259 include 'COMMON.FFIELD'
5260 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5261 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5264 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5265 cd & ' jj=',jj,' kk=',kk
5266 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5269 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5270 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5273 call transpose2(aa1(1,1),aa1t(1,1))
5274 call transpose2(aa2(1,1),aa2t(1,1))
5277 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5278 & aa1tder(1,1,lll,kkk))
5279 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5280 & aa2tder(1,1,lll,kkk))
5284 C parallel orientation of the two CA-CA-CA frames.
5286 iti=itortyp(itype(i))
5290 itk1=itortyp(itype(k+1))
5291 itj=itortyp(itype(j))
5292 if (l.lt.nres-1) then
5293 itl1=itortyp(itype(l+1))
5297 C A1 kernel(j+1) A2T
5299 cd write (iout,'(3f10.5,5x,3f10.5)')
5300 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
5302 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5303 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
5304 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5305 C Following matrices are needed only for 6-th order cumulants
5306 IF (wcorr6.gt.0.0d0) THEN
5307 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5308 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
5309 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5310 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5311 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
5312 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5313 & ADtEAderx(1,1,1,1,1,1))
5315 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5316 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
5317 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5318 & ADtEA1derx(1,1,1,1,1,1))
5320 C End 6-th order cumulants
5323 cd write (2,*) 'In calc_eello6'
5325 cd write (2,*) 'iii=',iii
5327 cd write (2,*) 'kkk=',kkk
5329 cd write (2,'(3(2f10.5),5x)')
5330 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
5335 call transpose2(EUgder(1,1,k),auxmat(1,1))
5336 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5337 call transpose2(EUg(1,1,k),auxmat(1,1))
5338 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5339 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5343 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5344 & EAEAderx(1,1,lll,kkk,iii,1))
5348 C A1T kernel(i+1) A2
5349 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5350 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
5351 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5352 C Following matrices are needed only for 6-th order cumulants
5353 IF (wcorr6.gt.0.0d0) THEN
5354 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5355 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
5356 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5357 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5358 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
5359 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5360 & ADtEAderx(1,1,1,1,1,2))
5361 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
5362 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
5363 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5364 & ADtEA1derx(1,1,1,1,1,2))
5366 C End 6-th order cumulants
5367 call transpose2(EUgder(1,1,l),auxmat(1,1))
5368 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
5369 call transpose2(EUg(1,1,l),auxmat(1,1))
5370 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5371 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5375 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5376 & EAEAderx(1,1,lll,kkk,iii,2))
5381 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5382 C They are needed only when the fifth- or the sixth-order cumulants are
5384 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
5385 call transpose2(AEA(1,1,1),auxmat(1,1))
5386 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5387 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5388 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5389 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5390 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5391 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5392 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5393 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5394 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5395 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5396 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5397 call transpose2(AEA(1,1,2),auxmat(1,1))
5398 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
5399 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
5400 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
5401 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5402 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
5403 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
5404 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
5405 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
5406 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
5407 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
5408 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
5409 C Calculate the Cartesian derivatives of the vectors.
5413 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5414 call matvec2(auxmat(1,1),b1(1,iti),
5415 & AEAb1derx(1,lll,kkk,iii,1,1))
5416 call matvec2(auxmat(1,1),Ub2(1,i),
5417 & AEAb2derx(1,lll,kkk,iii,1,1))
5418 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5419 & AEAb1derx(1,lll,kkk,iii,2,1))
5420 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5421 & AEAb2derx(1,lll,kkk,iii,2,1))
5422 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5423 call matvec2(auxmat(1,1),b1(1,itj),
5424 & AEAb1derx(1,lll,kkk,iii,1,2))
5425 call matvec2(auxmat(1,1),Ub2(1,j),
5426 & AEAb2derx(1,lll,kkk,iii,1,2))
5427 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
5428 & AEAb1derx(1,lll,kkk,iii,2,2))
5429 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
5430 & AEAb2derx(1,lll,kkk,iii,2,2))
5437 C Antiparallel orientation of the two CA-CA-CA frames.
5439 iti=itortyp(itype(i))
5443 itk1=itortyp(itype(k+1))
5444 itl=itortyp(itype(l))
5445 itj=itortyp(itype(j))
5446 if (j.lt.nres-1) then
5447 itj1=itortyp(itype(j+1))
5451 C A2 kernel(j-1)T A1T
5452 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5453 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
5454 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
5455 C Following matrices are needed only for 6-th order cumulants
5456 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5457 & j.eq.i+4 .and. l.eq.i+3)) THEN
5458 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5459 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
5460 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
5461 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5462 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
5463 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
5464 & ADtEAderx(1,1,1,1,1,1))
5465 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
5466 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
5467 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
5468 & ADtEA1derx(1,1,1,1,1,1))
5470 C End 6-th order cumulants
5471 call transpose2(EUgder(1,1,k),auxmat(1,1))
5472 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
5473 call transpose2(EUg(1,1,k),auxmat(1,1))
5474 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
5475 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
5479 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5480 & EAEAderx(1,1,lll,kkk,iii,1))
5484 C A2T kernel(i+1)T A1
5485 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5486 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
5487 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
5488 C Following matrices are needed only for 6-th order cumulants
5489 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
5490 & j.eq.i+4 .and. l.eq.i+3)) THEN
5491 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5492 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
5493 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
5494 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5495 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
5496 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
5497 & ADtEAderx(1,1,1,1,1,2))
5498 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
5499 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
5500 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
5501 & ADtEA1derx(1,1,1,1,1,2))
5503 C End 6-th order cumulants
5504 call transpose2(EUgder(1,1,j),auxmat(1,1))
5505 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
5506 call transpose2(EUg(1,1,j),auxmat(1,1))
5507 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
5508 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
5512 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5513 & EAEAderx(1,1,lll,kkk,iii,2))
5518 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
5519 C They are needed only when the fifth- or the sixth-order cumulants are
5521 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
5522 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
5523 call transpose2(AEA(1,1,1),auxmat(1,1))
5524 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
5525 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
5526 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
5527 call transpose2(AEAderg(1,1,1),auxmat(1,1))
5528 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
5529 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
5530 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
5531 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
5532 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
5533 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
5534 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
5535 call transpose2(AEA(1,1,2),auxmat(1,1))
5536 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
5537 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
5538 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
5539 call transpose2(AEAderg(1,1,2),auxmat(1,1))
5540 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
5541 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
5542 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
5543 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
5544 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
5545 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
5546 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
5547 C Calculate the Cartesian derivatives of the vectors.
5551 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
5552 call matvec2(auxmat(1,1),b1(1,iti),
5553 & AEAb1derx(1,lll,kkk,iii,1,1))
5554 call matvec2(auxmat(1,1),Ub2(1,i),
5555 & AEAb2derx(1,lll,kkk,iii,1,1))
5556 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
5557 & AEAb1derx(1,lll,kkk,iii,2,1))
5558 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
5559 & AEAb2derx(1,lll,kkk,iii,2,1))
5560 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
5561 call matvec2(auxmat(1,1),b1(1,itl),
5562 & AEAb1derx(1,lll,kkk,iii,1,2))
5563 call matvec2(auxmat(1,1),Ub2(1,l),
5564 & AEAb2derx(1,lll,kkk,iii,1,2))
5565 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
5566 & AEAb1derx(1,lll,kkk,iii,2,2))
5567 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
5568 & AEAb2derx(1,lll,kkk,iii,2,2))
5577 C---------------------------------------------------------------------------
5578 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
5579 & KK,KKderg,AKA,AKAderg,AKAderx)
5583 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
5584 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
5585 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
5590 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
5592 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
5595 cd if (lprn) write (2,*) 'In kernel'
5597 cd if (lprn) write (2,*) 'kkk=',kkk
5599 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
5600 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
5602 cd write (2,*) 'lll=',lll
5603 cd write (2,*) 'iii=1'
5605 cd write (2,'(3(2f10.5),5x)')
5606 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
5609 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
5610 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
5612 cd write (2,*) 'lll=',lll
5613 cd write (2,*) 'iii=2'
5615 cd write (2,'(3(2f10.5),5x)')
5616 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
5623 C---------------------------------------------------------------------------
5624 double precision function eello4(i,j,k,l,jj,kk)
5625 implicit real*8 (a-h,o-z)
5626 include 'DIMENSIONS'
5627 include 'sizesclu.dat'
5628 include 'COMMON.IOUNITS'
5629 include 'COMMON.CHAIN'
5630 include 'COMMON.DERIV'
5631 include 'COMMON.INTERACT'
5632 include 'COMMON.CONTACTS'
5633 include 'COMMON.TORSION'
5634 include 'COMMON.VAR'
5635 include 'COMMON.GEO'
5636 double precision pizda(2,2),ggg1(3),ggg2(3)
5637 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
5641 cd print *,'eello4:',i,j,k,l,jj,kk
5642 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
5643 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
5644 cold eij=facont_hb(jj,i)
5645 cold ekl=facont_hb(kk,k)
5647 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
5649 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
5650 gcorr_loc(k-1)=gcorr_loc(k-1)
5651 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
5653 gcorr_loc(l-1)=gcorr_loc(l-1)
5654 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5656 gcorr_loc(j-1)=gcorr_loc(j-1)
5657 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
5662 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
5663 & -EAEAderx(2,2,lll,kkk,iii,1)
5664 cd derx(lll,kkk,iii)=0.0d0
5668 cd gcorr_loc(l-1)=0.0d0
5669 cd gcorr_loc(j-1)=0.0d0
5670 cd gcorr_loc(k-1)=0.0d0
5672 cd write (iout,*)'Contacts have occurred for peptide groups',
5673 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
5674 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
5675 if (j.lt.nres-1) then
5682 if (l.lt.nres-1) then
5690 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
5691 ggg1(ll)=eel4*g_contij(ll,1)
5692 ggg2(ll)=eel4*g_contij(ll,2)
5693 ghalf=0.5d0*ggg1(ll)
5695 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
5696 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
5697 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
5698 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
5699 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
5700 ghalf=0.5d0*ggg2(ll)
5702 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
5703 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
5704 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
5705 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
5710 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
5711 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
5716 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
5717 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
5723 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
5728 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
5732 cd write (2,*) iii,gcorr_loc(iii)
5736 cd write (2,*) 'ekont',ekont
5737 cd write (iout,*) 'eello4',ekont*eel4
5740 C---------------------------------------------------------------------------
5741 double precision function eello5(i,j,k,l,jj,kk)
5742 implicit real*8 (a-h,o-z)
5743 include 'DIMENSIONS'
5744 include 'sizesclu.dat'
5745 include 'COMMON.IOUNITS'
5746 include 'COMMON.CHAIN'
5747 include 'COMMON.DERIV'
5748 include 'COMMON.INTERACT'
5749 include 'COMMON.CONTACTS'
5750 include 'COMMON.TORSION'
5751 include 'COMMON.VAR'
5752 include 'COMMON.GEO'
5753 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
5754 double precision ggg1(3),ggg2(3)
5755 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5760 C /l\ / \ \ / \ / \ / C
5761 C / \ / \ \ / \ / \ / C
5762 C j| o |l1 | o | o| o | | o |o C
5763 C \ |/k\| |/ \| / |/ \| |/ \| C
5764 C \i/ \ / \ / / \ / \ C
5766 C (I) (II) (III) (IV) C
5768 C eello5_1 eello5_2 eello5_3 eello5_4 C
5770 C Antiparallel chains C
5773 C /j\ / \ \ / \ / \ / C
5774 C / \ / \ \ / \ / \ / C
5775 C j1| o |l | o | o| o | | o |o C
5776 C \ |/k\| |/ \| / |/ \| |/ \| C
5777 C \i/ \ / \ / / \ / \ C
5779 C (I) (II) (III) (IV) C
5781 C eello5_1 eello5_2 eello5_3 eello5_4 C
5783 C o denotes a local interaction, vertical lines an electrostatic interaction. C
5785 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5786 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
5791 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
5793 itk=itortyp(itype(k))
5794 itl=itortyp(itype(l))
5795 itj=itortyp(itype(j))
5800 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
5801 cd & eel5_3_num,eel5_4_num)
5805 derx(lll,kkk,iii)=0.0d0
5809 cd eij=facont_hb(jj,i)
5810 cd ekl=facont_hb(kk,k)
5812 cd write (iout,*)'Contacts have occurred for peptide groups',
5813 cd & i,j,' fcont:',eij,' eij',' and ',k,l
5815 C Contribution from the graph I.
5816 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
5817 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
5818 call transpose2(EUg(1,1,k),auxmat(1,1))
5819 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
5820 vv(1)=pizda(1,1)-pizda(2,2)
5821 vv(2)=pizda(1,2)+pizda(2,1)
5822 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
5823 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5825 C Explicit gradient in virtual-dihedral angles.
5826 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
5827 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
5828 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
5829 call transpose2(EUgder(1,1,k),auxmat1(1,1))
5830 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
5831 vv(1)=pizda(1,1)-pizda(2,2)
5832 vv(2)=pizda(1,2)+pizda(2,1)
5833 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5834 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
5835 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5836 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
5837 vv(1)=pizda(1,1)-pizda(2,2)
5838 vv(2)=pizda(1,2)+pizda(2,1)
5840 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
5841 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5842 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5844 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
5845 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
5846 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
5848 C Cartesian gradient
5852 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
5854 vv(1)=pizda(1,1)-pizda(2,2)
5855 vv(2)=pizda(1,2)+pizda(2,1)
5856 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5857 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
5858 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
5865 C Contribution from graph II
5866 call transpose2(EE(1,1,itk),auxmat(1,1))
5867 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
5868 vv(1)=pizda(1,1)+pizda(2,2)
5869 vv(2)=pizda(2,1)-pizda(1,2)
5870 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
5871 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5873 C Explicit gradient in virtual-dihedral angles.
5874 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5875 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
5876 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
5877 vv(1)=pizda(1,1)+pizda(2,2)
5878 vv(2)=pizda(2,1)-pizda(1,2)
5880 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5881 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5882 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5884 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5885 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
5886 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
5888 C Cartesian gradient
5892 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
5894 vv(1)=pizda(1,1)+pizda(2,2)
5895 vv(2)=pizda(2,1)-pizda(1,2)
5896 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5897 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
5898 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
5907 C Parallel orientation
5908 C Contribution from graph III
5909 call transpose2(EUg(1,1,l),auxmat(1,1))
5910 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5911 vv(1)=pizda(1,1)-pizda(2,2)
5912 vv(2)=pizda(1,2)+pizda(2,1)
5913 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
5914 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5916 C Explicit gradient in virtual-dihedral angles.
5917 g_corr5_loc(j-1)=g_corr5_loc(j-1)
5918 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
5919 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
5920 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5921 vv(1)=pizda(1,1)-pizda(2,2)
5922 vv(2)=pizda(1,2)+pizda(2,1)
5923 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5924 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
5925 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5926 call transpose2(EUgder(1,1,l),auxmat1(1,1))
5927 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
5928 vv(1)=pizda(1,1)-pizda(2,2)
5929 vv(2)=pizda(1,2)+pizda(2,1)
5930 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5931 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
5932 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
5933 C Cartesian gradient
5937 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
5939 vv(1)=pizda(1,1)-pizda(2,2)
5940 vv(2)=pizda(1,2)+pizda(2,1)
5941 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5942 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
5943 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
5949 C Contribution from graph IV
5951 call transpose2(EE(1,1,itl),auxmat(1,1))
5952 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
5953 vv(1)=pizda(1,1)+pizda(2,2)
5954 vv(2)=pizda(2,1)-pizda(1,2)
5955 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
5956 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5958 C Explicit gradient in virtual-dihedral angles.
5959 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5960 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
5961 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
5962 vv(1)=pizda(1,1)+pizda(2,2)
5963 vv(2)=pizda(2,1)-pizda(1,2)
5964 g_corr5_loc(k-1)=g_corr5_loc(k-1)
5965 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
5966 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
5967 C Cartesian gradient
5971 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
5973 vv(1)=pizda(1,1)+pizda(2,2)
5974 vv(2)=pizda(2,1)-pizda(1,2)
5975 derx(lll,kkk,iii)=derx(lll,kkk,iii)
5976 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
5977 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
5983 C Antiparallel orientation
5984 C Contribution from graph III
5986 call transpose2(EUg(1,1,j),auxmat(1,1))
5987 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
5988 vv(1)=pizda(1,1)-pizda(2,2)
5989 vv(2)=pizda(1,2)+pizda(2,1)
5990 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
5991 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
5993 C Explicit gradient in virtual-dihedral angles.
5994 g_corr5_loc(l-1)=g_corr5_loc(l-1)
5995 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
5996 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
5997 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
5998 vv(1)=pizda(1,1)-pizda(2,2)
5999 vv(2)=pizda(1,2)+pizda(2,1)
6000 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6001 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6002 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6003 call transpose2(EUgder(1,1,j),auxmat1(1,1))
6004 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6005 vv(1)=pizda(1,1)-pizda(2,2)
6006 vv(2)=pizda(1,2)+pizda(2,1)
6007 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6008 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6009 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6010 C Cartesian gradient
6014 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6016 vv(1)=pizda(1,1)-pizda(2,2)
6017 vv(2)=pizda(1,2)+pizda(2,1)
6018 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6019 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6020 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6026 C Contribution from graph IV
6028 call transpose2(EE(1,1,itj),auxmat(1,1))
6029 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6030 vv(1)=pizda(1,1)+pizda(2,2)
6031 vv(2)=pizda(2,1)-pizda(1,2)
6032 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6033 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6035 C Explicit gradient in virtual-dihedral angles.
6036 g_corr5_loc(j-1)=g_corr5_loc(j-1)
6037 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6038 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6039 vv(1)=pizda(1,1)+pizda(2,2)
6040 vv(2)=pizda(2,1)-pizda(1,2)
6041 g_corr5_loc(k-1)=g_corr5_loc(k-1)
6042 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6043 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6044 C Cartesian gradient
6048 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6050 vv(1)=pizda(1,1)+pizda(2,2)
6051 vv(2)=pizda(2,1)-pizda(1,2)
6052 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6053 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6054 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
6061 eel5=eello5_1+eello5_2+eello5_3+eello5_4
6062 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6063 cd write (2,*) 'ijkl',i,j,k,l
6064 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6065 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
6067 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6068 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6069 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6070 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6072 if (j.lt.nres-1) then
6079 if (l.lt.nres-1) then
6089 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6091 ggg1(ll)=eel5*g_contij(ll,1)
6092 ggg2(ll)=eel5*g_contij(ll,2)
6093 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6094 ghalf=0.5d0*ggg1(ll)
6096 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6097 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6098 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6099 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6100 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6101 ghalf=0.5d0*ggg2(ll)
6103 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6104 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6105 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6106 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6111 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6112 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6117 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6118 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6124 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6129 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6133 cd write (2,*) iii,g_corr5_loc(iii)
6137 cd write (2,*) 'ekont',ekont
6138 cd write (iout,*) 'eello5',ekont*eel5
6141 c--------------------------------------------------------------------------
6142 double precision function eello6(i,j,k,l,jj,kk)
6143 implicit real*8 (a-h,o-z)
6144 include 'DIMENSIONS'
6145 include 'sizesclu.dat'
6146 include 'COMMON.IOUNITS'
6147 include 'COMMON.CHAIN'
6148 include 'COMMON.DERIV'
6149 include 'COMMON.INTERACT'
6150 include 'COMMON.CONTACTS'
6151 include 'COMMON.TORSION'
6152 include 'COMMON.VAR'
6153 include 'COMMON.GEO'
6154 include 'COMMON.FFIELD'
6155 double precision ggg1(3),ggg2(3)
6156 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6161 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6169 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6170 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6174 derx(lll,kkk,iii)=0.0d0
6178 cd eij=facont_hb(jj,i)
6179 cd ekl=facont_hb(kk,k)
6185 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6186 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6187 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6188 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6189 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6190 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6192 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6193 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6194 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6195 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6196 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6197 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6201 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6203 C If turn contributions are considered, they will be handled separately.
6204 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6205 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6206 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6207 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6208 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6209 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6210 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6213 if (j.lt.nres-1) then
6220 if (l.lt.nres-1) then
6228 ggg1(ll)=eel6*g_contij(ll,1)
6229 ggg2(ll)=eel6*g_contij(ll,2)
6230 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6231 ghalf=0.5d0*ggg1(ll)
6233 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6234 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6235 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6236 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6237 ghalf=0.5d0*ggg2(ll)
6238 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6240 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6241 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6242 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6243 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6248 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6249 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6254 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6255 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6261 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6266 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6270 cd write (2,*) iii,g_corr6_loc(iii)
6274 cd write (2,*) 'ekont',ekont
6275 cd write (iout,*) 'eello6',ekont*eel6
6278 c--------------------------------------------------------------------------
6279 double precision function eello6_graph1(i,j,k,l,imat,swap)
6280 implicit real*8 (a-h,o-z)
6281 include 'DIMENSIONS'
6282 include 'sizesclu.dat'
6283 include 'COMMON.IOUNITS'
6284 include 'COMMON.CHAIN'
6285 include 'COMMON.DERIV'
6286 include 'COMMON.INTERACT'
6287 include 'COMMON.CONTACTS'
6288 include 'COMMON.TORSION'
6289 include 'COMMON.VAR'
6290 include 'COMMON.GEO'
6291 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6295 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6297 C Parallel Antiparallel C
6303 C \ j|/k\| / \ |/k\|l / C
6308 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6309 itk=itortyp(itype(k))
6310 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6311 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6312 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6313 call transpose2(EUgC(1,1,k),auxmat(1,1))
6314 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6315 vv1(1)=pizda1(1,1)-pizda1(2,2)
6316 vv1(2)=pizda1(1,2)+pizda1(2,1)
6317 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6318 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
6319 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
6320 s5=scalar2(vv(1),Dtobr2(1,i))
6321 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
6322 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
6323 if (.not. calc_grad) return
6324 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
6325 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
6326 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
6327 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
6328 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
6329 & +scalar2(vv(1),Dtobr2der(1,i)))
6330 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
6331 vv1(1)=pizda1(1,1)-pizda1(2,2)
6332 vv1(2)=pizda1(1,2)+pizda1(2,1)
6333 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
6334 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
6336 g_corr6_loc(l-1)=g_corr6_loc(l-1)
6337 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6338 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6339 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6340 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6342 g_corr6_loc(j-1)=g_corr6_loc(j-1)
6343 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
6344 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
6345 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
6346 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
6348 call transpose2(EUgCder(1,1,k),auxmat(1,1))
6349 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6350 vv1(1)=pizda1(1,1)-pizda1(2,2)
6351 vv1(2)=pizda1(1,2)+pizda1(2,1)
6352 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
6353 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
6354 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
6355 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
6364 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
6365 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
6366 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
6367 call transpose2(EUgC(1,1,k),auxmat(1,1))
6368 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6370 vv1(1)=pizda1(1,1)-pizda1(2,2)
6371 vv1(2)=pizda1(1,2)+pizda1(2,1)
6372 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
6373 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
6374 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
6375 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
6376 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
6377 s5=scalar2(vv(1),Dtobr2(1,i))
6378 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
6384 c----------------------------------------------------------------------------
6385 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
6386 implicit real*8 (a-h,o-z)
6387 include 'DIMENSIONS'
6388 include 'sizesclu.dat'
6389 include 'COMMON.IOUNITS'
6390 include 'COMMON.CHAIN'
6391 include 'COMMON.DERIV'
6392 include 'COMMON.INTERACT'
6393 include 'COMMON.CONTACTS'
6394 include 'COMMON.TORSION'
6395 include 'COMMON.VAR'
6396 include 'COMMON.GEO'
6398 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6399 & auxvec1(2),auxvec2(2),auxmat1(2,2)
6402 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6404 C Parallel Antiparallel C
6410 C \ j|/k\| \ |/k\|l C
6415 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6416 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
6417 C AL 7/4/01 s1 would occur in the sixth-order moment,
6418 C but not in a cluster cumulant
6420 s1=dip(1,jj,i)*dip(1,kk,k)
6422 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
6423 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6424 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
6425 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
6426 call transpose2(EUg(1,1,k),auxmat(1,1))
6427 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
6428 vv(1)=pizda(1,1)-pizda(2,2)
6429 vv(2)=pizda(1,2)+pizda(2,1)
6430 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6431 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6433 eello6_graph2=-(s1+s2+s3+s4)
6435 eello6_graph2=-(s2+s3+s4)
6438 if (.not. calc_grad) return
6439 C Derivatives in gamma(i-1)
6442 s1=dipderg(1,jj,i)*dip(1,kk,k)
6444 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6445 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
6446 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6447 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6449 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6451 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6453 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
6455 C Derivatives in gamma(k-1)
6457 s1=dip(1,jj,i)*dipderg(1,kk,k)
6459 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
6460 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6461 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
6462 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6463 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6464 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
6465 vv(1)=pizda(1,1)-pizda(2,2)
6466 vv(2)=pizda(1,2)+pizda(2,1)
6467 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6469 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6471 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6473 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
6474 C Derivatives in gamma(j-1) or gamma(l-1)
6477 s1=dipderg(3,jj,i)*dip(1,kk,k)
6479 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
6480 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6481 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
6482 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
6483 vv(1)=pizda(1,1)-pizda(2,2)
6484 vv(2)=pizda(1,2)+pizda(2,1)
6485 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6488 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6490 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6493 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
6494 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
6496 C Derivatives in gamma(l-1) or gamma(j-1)
6499 s1=dip(1,jj,i)*dipderg(3,kk,k)
6501 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
6502 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
6503 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
6504 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
6505 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
6506 vv(1)=pizda(1,1)-pizda(2,2)
6507 vv(2)=pizda(1,2)+pizda(2,1)
6508 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6511 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
6513 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
6516 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
6517 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
6519 C Cartesian derivatives.
6521 write (2,*) 'In eello6_graph2'
6523 write (2,*) 'iii=',iii
6525 write (2,*) 'kkk=',kkk
6527 write (2,'(3(2f10.5),5x)')
6528 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6538 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
6540 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
6543 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
6545 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
6546 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
6548 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
6549 call transpose2(EUg(1,1,k),auxmat(1,1))
6550 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
6552 vv(1)=pizda(1,1)-pizda(2,2)
6553 vv(2)=pizda(1,2)+pizda(2,1)
6554 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
6555 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
6557 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6559 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6562 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6564 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6571 c----------------------------------------------------------------------------
6572 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
6573 implicit real*8 (a-h,o-z)
6574 include 'DIMENSIONS'
6575 include 'sizesclu.dat'
6576 include 'COMMON.IOUNITS'
6577 include 'COMMON.CHAIN'
6578 include 'COMMON.DERIV'
6579 include 'COMMON.INTERACT'
6580 include 'COMMON.CONTACTS'
6581 include 'COMMON.TORSION'
6582 include 'COMMON.VAR'
6583 include 'COMMON.GEO'
6584 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
6586 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6588 C Parallel Antiparallel C
6594 C j|/k\| / |/k\|l / C
6599 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6601 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6602 C energy moment and not to the cluster cumulant.
6603 iti=itortyp(itype(i))
6604 if (j.lt.nres-1) then
6605 itj1=itortyp(itype(j+1))
6609 itk=itortyp(itype(k))
6610 itk1=itortyp(itype(k+1))
6611 if (l.lt.nres-1) then
6612 itl1=itortyp(itype(l+1))
6617 s1=dip(4,jj,i)*dip(4,kk,k)
6619 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
6620 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6621 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
6622 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6623 call transpose2(EE(1,1,itk),auxmat(1,1))
6624 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
6625 vv(1)=pizda(1,1)+pizda(2,2)
6626 vv(2)=pizda(2,1)-pizda(1,2)
6627 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6628 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6630 eello6_graph3=-(s1+s2+s3+s4)
6632 eello6_graph3=-(s2+s3+s4)
6635 if (.not. calc_grad) return
6636 C Derivatives in gamma(k-1)
6637 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
6638 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6639 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
6640 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
6641 C Derivatives in gamma(l-1)
6642 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
6643 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6644 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
6645 vv(1)=pizda(1,1)+pizda(2,2)
6646 vv(2)=pizda(2,1)-pizda(1,2)
6647 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6648 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6649 C Cartesian derivatives.
6655 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
6657 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
6660 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6662 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
6663 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6665 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
6666 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
6668 vv(1)=pizda(1,1)+pizda(2,2)
6669 vv(2)=pizda(2,1)-pizda(1,2)
6670 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
6672 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6674 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6677 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6679 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6681 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
6687 c----------------------------------------------------------------------------
6688 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
6689 implicit real*8 (a-h,o-z)
6690 include 'DIMENSIONS'
6691 include 'sizesclu.dat'
6692 include 'COMMON.IOUNITS'
6693 include 'COMMON.CHAIN'
6694 include 'COMMON.DERIV'
6695 include 'COMMON.INTERACT'
6696 include 'COMMON.CONTACTS'
6697 include 'COMMON.TORSION'
6698 include 'COMMON.VAR'
6699 include 'COMMON.GEO'
6700 include 'COMMON.FFIELD'
6701 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
6702 & auxvec1(2),auxmat1(2,2)
6704 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6706 C Parallel Antiparallel C
6712 C \ j|/k\| \ |/k\|l C
6717 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6719 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
6720 C energy moment and not to the cluster cumulant.
6721 cd write (2,*) 'eello_graph4: wturn6',wturn6
6722 iti=itortyp(itype(i))
6723 itj=itortyp(itype(j))
6724 if (j.lt.nres-1) then
6725 itj1=itortyp(itype(j+1))
6729 itk=itortyp(itype(k))
6730 if (k.lt.nres-1) then
6731 itk1=itortyp(itype(k+1))
6735 itl=itortyp(itype(l))
6736 if (l.lt.nres-1) then
6737 itl1=itortyp(itype(l+1))
6741 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
6742 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
6743 cd & ' itl',itl,' itl1',itl1
6746 s1=dip(3,jj,i)*dip(3,kk,k)
6748 s1=dip(2,jj,j)*dip(2,kk,l)
6751 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
6752 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6754 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
6755 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6757 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
6758 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6760 call transpose2(EUg(1,1,k),auxmat(1,1))
6761 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
6762 vv(1)=pizda(1,1)-pizda(2,2)
6763 vv(2)=pizda(2,1)+pizda(1,2)
6764 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6765 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
6767 eello6_graph4=-(s1+s2+s3+s4)
6769 eello6_graph4=-(s2+s3+s4)
6771 if (.not. calc_grad) return
6772 C Derivatives in gamma(i-1)
6776 s1=dipderg(2,jj,i)*dip(3,kk,k)
6778 s1=dipderg(4,jj,j)*dip(2,kk,l)
6781 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
6783 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
6784 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6786 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
6787 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6789 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
6790 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6791 cd write (2,*) 'turn6 derivatives'
6793 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
6795 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
6799 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
6801 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
6805 C Derivatives in gamma(k-1)
6808 s1=dip(3,jj,i)*dipderg(2,kk,k)
6810 s1=dip(2,jj,j)*dipderg(4,kk,l)
6813 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
6814 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
6816 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
6817 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
6819 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
6820 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
6822 call transpose2(EUgder(1,1,k),auxmat1(1,1))
6823 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
6824 vv(1)=pizda(1,1)-pizda(2,2)
6825 vv(2)=pizda(2,1)+pizda(1,2)
6826 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6827 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6829 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
6831 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
6835 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
6837 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
6840 C Derivatives in gamma(j-1) or gamma(l-1)
6841 if (l.eq.j+1 .and. l.gt.1) then
6842 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6843 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6844 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6845 vv(1)=pizda(1,1)-pizda(2,2)
6846 vv(2)=pizda(2,1)+pizda(1,2)
6847 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6848 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
6849 else if (j.gt.1) then
6850 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
6851 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6852 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
6853 vv(1)=pizda(1,1)-pizda(2,2)
6854 vv(2)=pizda(2,1)+pizda(1,2)
6855 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6856 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6857 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
6859 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
6862 C Cartesian derivatives.
6869 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
6871 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
6875 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
6877 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
6881 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
6883 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
6885 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6886 & b1(1,itj1),auxvec(1))
6887 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
6889 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
6890 & b1(1,itl1),auxvec(1))
6891 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
6893 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
6895 vv(1)=pizda(1,1)-pizda(2,2)
6896 vv(2)=pizda(2,1)+pizda(1,2)
6897 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
6899 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
6901 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6904 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
6907 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
6910 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
6912 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
6914 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6918 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
6920 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
6923 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
6925 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
6933 c----------------------------------------------------------------------------
6934 double precision function eello_turn6(i,jj,kk)
6935 implicit real*8 (a-h,o-z)
6936 include 'DIMENSIONS'
6937 include 'sizesclu.dat'
6938 include 'COMMON.IOUNITS'
6939 include 'COMMON.CHAIN'
6940 include 'COMMON.DERIV'
6941 include 'COMMON.INTERACT'
6942 include 'COMMON.CONTACTS'
6943 include 'COMMON.TORSION'
6944 include 'COMMON.VAR'
6945 include 'COMMON.GEO'
6946 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
6947 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
6949 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
6950 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
6951 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
6952 C the respective energy moment and not to the cluster cumulant.
6957 iti=itortyp(itype(i))
6958 itk=itortyp(itype(k))
6959 itk1=itortyp(itype(k+1))
6960 itl=itortyp(itype(l))
6961 itj=itortyp(itype(j))
6962 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
6963 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
6964 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6969 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
6971 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
6975 derx_turn(lll,kkk,iii)=0.0d0
6982 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6984 cd write (2,*) 'eello6_5',eello6_5
6986 call transpose2(AEA(1,1,1),auxmat(1,1))
6987 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
6988 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
6989 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
6993 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
6994 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
6995 s2 = scalar2(b1(1,itk),vtemp1(1))
6997 call transpose2(AEA(1,1,2),atemp(1,1))
6998 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
6999 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7000 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7004 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7005 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7006 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7008 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7009 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7010 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7011 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7012 ss13 = scalar2(b1(1,itk),vtemp4(1))
7013 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7017 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7023 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7025 C Derivatives in gamma(i+2)
7027 call transpose2(AEA(1,1,1),auxmatd(1,1))
7028 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7029 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7030 call transpose2(AEAderg(1,1,2),atempd(1,1))
7031 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7032 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7036 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7037 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7038 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7044 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7045 C Derivatives in gamma(i+3)
7047 call transpose2(AEA(1,1,1),auxmatd(1,1))
7048 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7049 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7050 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7054 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7055 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7056 s2d = scalar2(b1(1,itk),vtemp1d(1))
7058 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7059 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7061 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7063 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7064 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7065 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7075 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7076 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7078 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7079 & -0.5d0*ekont*(s2d+s12d)
7081 C Derivatives in gamma(i+4)
7082 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7083 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7084 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7086 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7087 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7088 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7098 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7100 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7102 C Derivatives in gamma(i+5)
7104 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7105 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7106 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7110 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7111 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7112 s2d = scalar2(b1(1,itk),vtemp1d(1))
7114 call transpose2(AEA(1,1,2),atempd(1,1))
7115 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7116 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7120 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7121 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7123 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7124 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7125 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7135 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7136 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7138 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7139 & -0.5d0*ekont*(s2d+s12d)
7141 C Cartesian derivatives
7146 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7147 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7148 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7152 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7153 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7155 s2d = scalar2(b1(1,itk),vtemp1d(1))
7157 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7158 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7159 s8d = -(atempd(1,1)+atempd(2,2))*
7160 & scalar2(cc(1,1,itl),vtemp2(1))
7164 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7166 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7167 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7174 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7177 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7181 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7182 & - 0.5d0*(s8d+s12d)
7184 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7193 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7195 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7196 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7197 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7198 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7199 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7201 ss13d = scalar2(b1(1,itk),vtemp4d(1))
7202 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7203 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7207 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7208 cd & 16*eel_turn6_num
7210 if (j.lt.nres-1) then
7217 if (l.lt.nres-1) then
7225 ggg1(ll)=eel_turn6*g_contij(ll,1)
7226 ggg2(ll)=eel_turn6*g_contij(ll,2)
7227 ghalf=0.5d0*ggg1(ll)
7229 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7230 & +ekont*derx_turn(ll,2,1)
7231 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7232 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7233 & +ekont*derx_turn(ll,4,1)
7234 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7235 ghalf=0.5d0*ggg2(ll)
7237 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7238 & +ekont*derx_turn(ll,2,2)
7239 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7240 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7241 & +ekont*derx_turn(ll,4,2)
7242 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7247 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7252 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7258 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7263 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7267 cd write (2,*) iii,g_corr6_loc(iii)
7270 eello_turn6=ekont*eel_turn6
7271 cd write (2,*) 'ekont',ekont
7272 cd write (2,*) 'eel_turn6',ekont*eel_turn6
7275 crc-------------------------------------------------
7276 SUBROUTINE MATVEC2(A1,V1,V2)
7277 implicit real*8 (a-h,o-z)
7278 include 'DIMENSIONS'
7279 DIMENSION A1(2,2),V1(2),V2(2)
7283 c 3 VI=VI+A1(I,K)*V1(K)
7287 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7288 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7293 C---------------------------------------
7294 SUBROUTINE MATMAT2(A1,A2,A3)
7295 implicit real*8 (a-h,o-z)
7296 include 'DIMENSIONS'
7297 DIMENSION A1(2,2),A2(2,2),A3(2,2)
7298 c DIMENSION AI3(2,2)
7302 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
7308 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7309 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7310 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7311 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7319 c-------------------------------------------------------------------------
7320 double precision function scalar2(u,v)
7322 double precision u(2),v(2)
7325 scalar2=u(1)*v(1)+u(2)*v(2)
7329 C-----------------------------------------------------------------------------
7331 subroutine transpose2(a,at)
7333 double precision a(2,2),at(2,2)
7340 c--------------------------------------------------------------------------
7341 subroutine transpose(n,a,at)
7344 double precision a(n,n),at(n,n)
7352 C---------------------------------------------------------------------------
7353 subroutine prodmat3(a1,a2,kk,transp,prod)
7356 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
7358 crc double precision auxmat(2,2),prod_(2,2)
7361 crc call transpose2(kk(1,1),auxmat(1,1))
7362 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
7363 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7365 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
7366 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
7367 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
7368 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
7369 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
7370 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
7371 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
7372 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
7375 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
7376 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
7378 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
7379 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
7380 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
7381 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
7382 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
7383 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
7384 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
7385 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
7388 c call transpose2(a2(1,1),a2t(1,1))
7391 crc print *,((prod_(i,j),i=1,2),j=1,2)
7392 crc print *,((prod(i,j),i=1,2),j=1,2)
7396 C-----------------------------------------------------------------------------
7397 double precision function scalar(u,v)
7399 double precision u(3),v(3)